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This appendix to the User Manual for the Streamtube Curvature Analysis 
contains the computer program listing. It should be noted that the listing 
includes explanatory statements and titles so that the program flow is 
readily discernable. The computer program listing is in CDC Fortran 
2.3 source language form, except for three subroutines, GETIX, GETRLX, 
and SAVIX, which are in Compass 1. 1 language. 


ix 



o n o o r> Cl o 


•UtUK MAIN 

OVERLAY(STC.9,0) 

Program stcaOnput» output. tape5Vtape6*output# 

» TaPEi,TaPE2^TAPE4sTaPE2) 

COMMON /BCOMMN/ PROGM,TaP!N;TAPOT,ReF<5) .PROGSV, FILIN, pilot 
LOGICAL TAPIN.TAPOT, FILIN, FILOT 

equivalence ( IPROGM.PROGM) 

Common /AnAMfll/ NAME{6),ABDRES(A)iTITLE(6>.IDENT(6) 

COmmON /adAM62/ ENdj09,DUM1(2J .eNDCRD 

Logical endjqb, endcrd 

Common ^cbits / bits, blank 
equivalence ( I3LANK,BLANK1 

Common /cgrav / cg 
common /CNTRL / K5(8), CARRY, 'ICHN 
LOGICAL CARRY 

COMMON /IXORIG/ I I DUM( 21 ) , NM, f 1 1 DUM( 11 ) 

COMMON /KEYS / KE Y A (1 1 ) , KE VB ( 11 ) . KODA ( 22 ) 
dimension XKEYA<11) 

Equivalence (xkeya(I) ,keya(D } 

Common /troubl/ err, errmaj. inerr.prerr 
logical err,errmaj, inErr.prerr 

c 

Common /adjkFi/ mode.lff.modeo.'lfo 

Common ^cinner^ inrctr,rdum^ninneR(16) ,cnvf( 16> 

Common / cmaxa / es2mx, zmx. rmx» ds2mx. ldumy 

COMMON /cMaXIT/ M a X I T , M A JCTR , GREF I N , EDUM 
LOGICAL GREFIN 

COMMON /CPRIXT/ PPDUM( 6) ,PDUMf2B) 

COMMON /CSTALO/ NSSPTS 

Common /ctapos/ restrt,Endbdt,stcfiliK6sv 
LOGICAL RESTRT.ENDBDT.'STCFIL 

Common / cte / tolwf, tolwfu, texi2, twf, terwf, jret 
Common /ctolRl/ tolrl,maxsrp,clen,dmds2,toles2,nswp, 

I DSinMP,DSlMxA,DSlMXB,DSlRMS.DMES2,DSlRM0 

sgiref,tolinr 

c dsidmps Damping factor on dsi, «o for no damping, *i for nominal 

c DsimXAs mAX»BS1 

dsimxbs Max calculated dsi before damping 

OSlRMSs RMS OF THE CALCULATED DSlPS 

ES2MX s MAX 8 l POSITION ERROR AS DETERMINED BY THE FLOW BALANCE 
NOW STORED IN COMMON / CMAx4 /- 

DS2MX r Max Calculated sl adjustment 

NOW STORED IN COl«MON / CMAX4 /- 
NSWP 5 number of lrelax sweeps 
Common /tapes / ntapq,ntapn 
dimension AA^8) 

COMMON /select/ LENTRY 
Data ka/Iha/k kbdy/3hbdy/, stc/shstc/ 

Data itrue/iHt/ 

ntapo s 1 
ntapn = 2 
write (6;776fl) 

7760 FqrmAt(1H1,‘22X.28h» »CARD INPUT# *//> 

c I*^lTlALlZEi-- after READINq NaHELISTS ID.DIP 
PNDFIlE 5 
rewind 5 

7777 FoRMAT(lHl) 

7778 FormAT(8aiO) 

7775 Read {5,777a) aa 

If( EoF,5 > 7781,7776 

7776 write (6,7778) AA 
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READ<5|1001> name 

READ15,1001> addres 
READ(5i1001) ident 
1001 FORMAT <lxV6AlOJ 

READ (5,10021 1 n|1 , PROGM , T AP 1 N , T APOT 

format ( I2»lJ(iAlO»Ll»*’XiLl) 

WRITE (A^llOfl) pROGH, TAPlN, TAPOT 
FORMAT ( 1H1,10X,16HEXECUTING 
« 6HTAP0 Ts,'l2/) 

XKEyA(4)s PR8GM 


10U2 

11 

1100 


POT 

PROGMP, A6/1QX,6HTaP1N=»L2i5X 


PROGSvs PROGM 

endcrd* .false; 

ErrmAjs .FAlSEi 
PRERR s ‘FALSE* 

Rq 2 1*1*3 
*^EYA{I>» 

2 KEYB< 1 )* IBLANK 
i FILIN * TaPIN 
F Il,OT * TAPOT 
TAPIN * .false'. 

TAPOT = .FALSE. 

Err s .false', 
data iBDy/3HBDY/ 
t<5 * IBDY 

4 PROGM s bits 
8 K5 » KA 

Go TO 12 

c consecutive dIp l*st read 

5 read (5i 1003J INli 1N2. 1N3*1 n4 
1003 FORMAT(12;iXi3Al8) 

IF(E0Fi5) l’«7 


7 GO TO (20.9,10) , INI 
V K5 = KBD'^ 

K5(2) P In 3 
ICHN s 1 n4 
GO TO 12 
10 K5 * 1N2 
K5(2) * 1N3 


-INPUT SECTION 
12 LENTRY* 1 
LOVER 5 1 


entry stcn to (1,0> 


15 

1004 


iOOO 


19 


Call overlay<3Hstc,i»o ,6HRE5ALL) 
1F( ( ,NOT, INEHR) .and, (.NOT.EBR) 


) GO To 5 

rSW^'t;j?;J^HsSf"‘='?”i;7HERRC0D.,,2.5X.7HUNTR,... 

Call errorkiaherRst ) 

FORMatSihi//10X,26H»»<»»« J°B TERMiJ^ATED •«**•) 

STOP 

endjob* .true; 


INPUT processing COMPLETE**. BUILD TABLES 
20 LENTRY* 2 

CaU^0VERLaYI3^STc,1,0,6HRecaCL) 

IfIERR) go to 15 
Call fhead 
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WRITE (^,1140) 
RESTRTs.TRUE. 


c HtriME, Inner loop initialization 

210 LFF =0 

DS2MX = Bits 
NSWP = 0 

Gref In® .true; 
inRcTRs 0 

IF(RESTRT) 60 TO 215 
LOVER s 3 
LeNTRysI 

Call 0VERLAYf3HSTC,3, 0,6HRECAI:U 
IF(ERR) GO TO 15 
IF( iNOTIgrEFTn) go TO 230 
MaJCTRs MaJCTR*! 

C 

C BEGIN inner ITR LOOP, CALC STREANLfNE CURVATURE 
C ORTHOGONALIZE <®E220) 

215 RESTRTs .FALSE'. 
lover = 3 
LENTRye 2 

Call overlay(3hstc,3,o,6hrecalli 

IF(ERR) GO TO 15 

c adjust flows AT CHOKED STATIONS 
TEXI2 * bits 
twf s bits 
terwf s bits 
LFO * 0 
MODEO s 0 
LOVER = 2 
LENTRy:i 1 

CALL 0VERLAYt3HSTC#2, 0,6HRECACL) 

IF (ERR) GO TO i5 
C 

C PERFORM FLOW BALANCE, BEGIN FLOW ADJUSTMENT LOOP 

227 lover a 2 
LENTRY? 4 

Call overlay(3Hstc,2,o,6hrecall) 

IF(ERR) GO TO 15 
AES2MX a aBS ( ES2MX ) 

ES2L1M q SGIREF • TOLINR 
FES2LM a CLES » T0LES2 

IF(MAJCTr:gE7MAXIT .or. .NOT.GReFINI ES2LIM a FES2LM 
TOLWFu a JOL'aF 

IF( AES2MX.GE.ES2LM ,OR. MAjCTR'.EQ.O ) Go TO 228 
MODE a ;i 
LENTRY ^ 3 

Call overlat(3hstc,2,o,6hrecall j 

IF(ERR) GO to 15 

228 TufP a TWF/CG 
TERWFP a TER(iF/C6 
IF(TEXI2 ,eq;BiTS) go to 2303 

WRITE (6,1252) mA JCTR, NM| INRCTRVnSSPTSi NSWP. DS2MX, ES2mX, 

1 ES2LlM,ZMX,l»MX,TEX12,TWrP,TERWrP 
GO TO 230 

2303 write ( 6, 1252} M A JCTR , NM i I NRCTR, nSSPTS* NSWP , DS 2MX i ES2MX , ES2 l I M , 

2 ZMx.'rMX 

230 McTR a M aX 0 < 1 , MA JCTR ) 

IF( INRCTR'.GE'TNINNERIMCTR) ) GO TO 232 
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jr( ;NOT;GRErjN) , BS2UIM«CLEN*T0L6$2 

ir ( INRCtR .EO. 0 .or. AESEBX .GE. ES2LIM ) GO TO 240 
^ ES2 converged 

ir (MODE’.Eo'.S ; 0 «i 'lAJCTR.EQlOE) GO TO 2 S 2 
mode ■ 1 
UENTRy ■ 3 

Call ovbrLay^3Hstc»2#0i6hrecallj 

ir ( H0DE^2 } 231,231,232 

231 DS2MX « BITS 
NSWP s 10ITS 
TEX12 a BITS 
TWF • BITS 
TERWF i Bits 
GO TO 227 

c ES 2 and ruOM adj ar,e converged 

232 IP(MAJCTr;gb7mAXIT ; 0 R, .aot.QRBFlNl GO TO 300 
Go TO 210 

c- MATRic Solution 
240 lover a 4 

Call ovbrlay<3hstc,4,oj 
IF(ERR) go to 15 
C ADJUST streamlines 
250 LOVER a 3 
LENTRy? 3 

Call OVBRLAVesHSTCiSiOiEHRECALLi 
IF(ERR) go to 15 
iNRCTRf INRCTR*! 

GO to 215 


C £S2 and flow adj CONVERGED, REFINEMENT. SATISFIED 
300 LOVER 4 2 « * 

LENTRYa 2 

Call ovBrlay(3hstc»2, o,6hrecalli 
IF(PDUM(io);EQ;2. ) call edumps 
IF(ERR) go to 15 
IF(ENDJOB) go to 100 
*F| IN3;eO'. ITRUe ) TAPINsiTRUe; 

IP' IN4:eo;ITRUE > TAPOTa.TRUfi*. 

IPROGMs IN2 
Go TO 11 
C 


100 

>000 


Ohnn <6.2000) 

2000 Format (1m1?/i0x,26w»****»*** Endjob *• 
1140 format (1H0»55X.19hS0LUTI0N HISTORY/ 

1 55x,2ih;;;-#.;-;-— 

2 2X,121HRePISEMENT ♦ INNER ITERS 

^ FLOW balance ERROR « • 

4 100X,31HtRA^LInG FLOw FbacTIONaL/ 


♦ MATRIX SOLUTION ♦ e 

♦ kutta iteration/ 


5 lX,l30WNREFtN GRID INRCTR NSSPTS NSWEEPS MAXeDS2 MAX- 

7 ERROR/^*”’^®^ Z R EDGE-X12 RATE FLOW 

8 30H pTS /) 

1252 format <I5;6X;I3.5X.I2,4X,U.6X;I3,4X.F9;6,2X.F9.6,2X,F9.6, 

1 3X,F8,3,3X,F0;3,6X,F4,O,4X;F9;4.4X,F7,4) 
stop 


End 
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•DECK USECDG 

block Data osecdg 

•UStCDG REPLACE LFIELD USE CAROS 

COMMON /alLCOM/ CK24) 

COMMON /CAO / AO 
COMMON /CPRlPiT/ C32<26) 

COMMON /CTHICK/ C7(302J 
COMMON ^CIDEM f C5(6) 

COMMON /CFRFtN/ C3(6) 

COMMON /cbEaR?/ C30<20) 

COMMON /CDS2 / Cl2(900) 

COMMON /CRHS / RHS<768) 

common /CHDATa/ C9(2200) 

COMMON /CBND / C2(2) 

Common /ccurv / cuRv(76S) 
common /CPHll / PHIK76B) 

COMMON /CSI / SK768) 

COMMON /CS2 / S2(760) 

COMMON /SlTAB / C0(384) 

COMMON /cm / JMS<768) 

COMMON /CB / 8(768) 

COMMON /C2 / 2(768) 

COMMON /CR / R(760) 

COMMON /CVM / VM(768) 

COMMON /CFRFLO/ C4(830) 

COMMON /ERASE2/ C3K1536) 

End 
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toe'll \aL9V<>0lcr SCQ^ 

■V«0(t ''*'10, / 1 |'jV.»"'’'*V 

DQIAWW ',® \SC«5' K««£f 

C0"«'>*' '^' , ,-sT9l. , 

"oVhW .,...l0-.6--»'^’®’‘ 

tOG\^^'l. 0/6®*®! 

o^V, '■R£si«'.'»' 


( 
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•DECK STCBUK 

Block data stcblk 

•STCBLK STC block data ’STCBLK' 

COMMON /ALLCOM/ M A CH A , PS A , TSA^Pt A , TT A, AX I A , RG A , GAMA, 

* MACHC#PSC,TSC;ptC,T7Ci AX 1C ,'RGC ,GAMC , 

* daxit.scalf-a.tte.chotst 

logical AXIA, AXICiCHOTSt 

REAL MACWA(l) ,MACHC 

COMMON /BENDIN/ N0CI V( 2 ) i ACP ( 2 ) 

COMMON /CBlTB / BITS, BLANK 

Common /ccrx / crxsl,crxol;crxss,crxe,crxc,dcrx 
DIMENSION CRX(6 ) 

equivalence (CRXiCRXSL) 

Common /cr 82 / passi 
logical. passi 

Common /corav / cg 
Common ^'ciadIn/ Rhobas,rhoamp;iadm 
COMMON /CINNBR/ IN9CTR,RDyM;NlNNER(16) ,CNVrt 16) 

Common /cisbot/ rARFL0(2)»rREE(2)*PRES(2 > »pspisviNzp» 

& ZP(10),PSP(1OJ,NZP1,DISbOT,aDUM(6) 

INTEGER rARFLD.FREE.'PRES.PSPlSV 

Common /ciVP / lVP,VPDUM,NRFt2),lNR(2),XIVP(2) 

MXLRLX 

common /CLiNgS/ lines, OMITFk,PTI'TLE(6) 
common /CMAXtT/ M aXREF , NREP I N,GREF1 N , TL 
COMMON/CNORM / RHLiRM, ahl»arm 
common /CPI / PI , TKOPI ,PlQ2,Pi04, TODEQ, TQHAD 
COMMON /CPRPUN/ PRPRN 
integer PRPRN 

COMMON /CPTMfiV/ VELPOT , I COB .‘NODENS , PBASTG 
LOGICAL VELPOT 

COMMON /crefin/ drefin,sg2i;v6gi , VMG2, NQR ,NGZ, SGRUO ) , QR( lO ) , 

snz(io) iGZdOj 
dimension G40(40) 

equivalence <G40,SGR) 

COMMON /CSLC / BRANCH(4) 

COMMON /CSS / SSFMLf SSEF,SSeANG,SSDF,SSFEND.SSFNDli 

^ DSS( 2) ,rhow;rhowss,tsic,rhoc,rhocss 

INTEGER SSFML 

LOGICAL SSEF, SSDF 

COMMON /CTE / TOL WF , TOLHFU, TEX 1 2 , TWF , TERWF , JRET 
COMMON /CTOLRL/ TolRL » M AXSWP . CLEN , DTOLR l , T0LES2 , NSWP # 

& DS1DMP,DS1DP1;DT0LR2(4) ,SGirEF,TOLINR 

COMMON /iXQRfG/ LHO.uHE, L8D0,LBDE, LT0,LTE, LW0,LWE, LF0,LFE, 

® L0iLESTA,LS0»LSB,LDUM(6) , 

« MO»NM* NJ*NFColS» MAXN J .mAXOL *MAXNM i MAXlE » 

« Leo, LEE, LR0,1:R6,URD 

COMMON /SLTA02/ PTR«128) 

C COMMONS NOT PR£SeNT jN GE VeRSfON 

COMMON /C8EN6 / NRCB < 2 ) , ANGE< 2 > .'CURVE ( 2 ) , FB( 2 ) 

COMMON /CBOW / BSHQCK,DUMBS(8) 

LOGICAL BSHOCK 

COMMON /CCU8E / NBC ( 2 ) , Cl t 2 ) , C2( 2? , FEND { 2 ) 

Common /ceduhp/ iqodmp 

COMMON /CLFITI/ LFOUT 
LOGICAL LFOUT 

COMMON /CPRINT/ PPK < 6 ) , PdUM^2B ) 

Common /linmAx/ lmax 

Data MACHa/ 0877777777777/, PSA,PTA/2*14i696/; TSA , TTA/2#5J8 ; 7/, 
« AXIA/'.TRUE;/, RGA/1716:2/, GAMA/1,4/, SCALEA/1,/, 
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c 

c 


GE 


GE 


4 TTE/0,/» ChOTST/.TRUE,/ 

NBClN/2i2/, AC^/0,,0./ 

BITS/0377777777777/, SLANK/IH / 
CRX/;37S.;375,;i25,0.,0.;0:/ 

PASSI/'.TRUE./ 
cQ/32‘,174/ 

RHOBaS,^HOAMP,I ADM/,5»;5;0/ 

NlNNBR^*6*l0^iCMVF/i6«l,/ 

DELEtEO 

PSPlSV.HZP.NZPl/O.O.O/ 

- ADUH<^> IS USED TO EXTB^O FAR HBLD BOUNDARY 
NRF/1,0/. 1nR/1iO/i XlVP/liB6»0./i MXLRLX/5/ 
deleted 
tl/i;e6/ 

RN/Oj/ 

Pl/3, 14159265/, TWOPl/6, 2831853/, PlQ2/li57079632/, 

PIQ4/, 78539816/, TODEQ/57 2957795/ . TQRAD/ *, 0174532925/ 
PRPRN/0/ 

velpoT/R/, 1COB/-1/, nodens/o/,fbastq/o;/ 
G40/40*8377777777777/, NSR/1/, 

VMGi;VMfi2/lOQ, ,100,/, SG«/iO . , 9*0 , / , SQ21/1,/ 

6R A|^ ^ ^ ^ / 

ssfml'/i/. S8EF/, false;/, sseanq/o;/, ssdf/, false;/ 

SSFEnD,SSFn01/;75, ,75/; TSIC/2./, 

‘ rhow;rhomssiRhoc,rhocss/i;;i. ,1, ,i;/ 

Data tolwf/’.adi/ 

Data TOLRl'/lTEiS/, MAXSWP/200/ ; T0LES2/l,Ei3/, 

DSlDMP,'8slDPl/0, , ,3/, SGIRBF/O,/, TOLINR/.05/ 

Data LHO;lHE/1,0/, M0iNM/1,0/; NFCOLS/20/, MAXNJiMAXOL/128,96/, 
I LEO.'lEE/I.O/, LRO,LRE/i»fl/ 

Data ptr/i28»i;/ 


& 


& 


Data 

Data 

Data 

Data 

Data 

Data 

Data 

lines 

Data 

NOTE 

Data 

line 

Data 

Data 

Data 

t 

t 

Data 

Data 

Data 

i 

Data 

Data 
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data different from or NOT present in GE VERSION 

Data MACha/17e15/,PSAiPTA/2h14;696/,tSA;tTA/ 2*518,7/ 
PSA;ptA»fTSA.TTA,RG/5»i:/ 

BITS/1*,B15/ 

{FARFLO(I),IsI, 2)/10HFF 
(rREEM),Uli2)/10HFREEl 
(PRESIU, Ib1,2)/10HPRE81 
ADUM/;2J,5«0,/ 

<PTitLE/I ), I«1,6)/6H 
« 6HTURE Pi’6MR0GrAm/ 
data G40/40«1‘.Ei5/,VHG1,VMG2/;i;;1/ 

NGZ/O/; SGZ/10*0./, DRErtN/;oi/ 

DS1dmP/'. 02/, SGIREF/lo'.E*/ 


Data 

Data 

Data 

data 

Data 

Data 

Data 


Data 

Data 


,10m 

I10HFREE2 

iIOHPRES2 


/ 

/ 


'6H STRe,6HAMTUBE,6H CURVA, 


Data 

Data 

Data 

Data 

Data 

data 

End 


BSHOCK/F/ 

NBC/2*0/,c1.c2,FEND/2#0,;2*0, ,2#0,/ 
IGODMP^I'' 

LFOut/F/ 

ppk/6«o7/»pdum/o , ,1, ,o; , t;;i6*o,/ 

LMAx/64/ 
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•DECK EDUMPS 

Subroutine eoumps 

•EDUMPS termiSal bdump tedumpsi 

subroutine ebumps 


Common /chdaTa/ 

COMMON /CB / 

common /ccurv / 

COMMON ^CDS2 / 

Common /cideii / 

COMMON /CLIMBs/ 

LOGICAL 

Common /cm / 

Common /cphii / 
common /cr / 

Common /crhs / 

Common /csi / 

Common /cs2 / 

COMMON /CTAB^R/ 

COMMON /CVM / 

Common /cz / 

COMMON /ixORiq/ 

& 

& 

& 

IlTAB a L.WO 

Call TABPRt<6HWAKET0,TA9LES;uyE;2T 
IITAB s lpo 

Call TABPRtliHCADjWriTABUBS.'LPE.’ay 
IiTaB a |_0 

Call TA0PRT<6HSTATAB,TABUES;LBSTA,9) 

L * LO 
LMAX a 1 ,ESTA 
OmITFKs .TRU8*. 

LINES a 64 
190 M 4 B MlB(L) 

Mb ® MUBtli) 

Call fhbad(mb*ma*2) 

If <tINes'.EQ:<MBaMA*5) ) WRITE (6*i200) 

WRITE (6,1208) 

DO 200 MbMAiMb 

Call getix 

Write (6*i20i) j.m.muimd.istasi si(M>isa(M)iZ(M)#R(M),PHii(M); 
& CuRV(M) iVMlM) iB(M) IRHSOO »0S2<M) 

200 continue 

L » L*LNBXT(L> 

IF(L ,LE;lMAXI 60 TO 190 

1200 F0RMAt(97Xi16HFiBlD TABLE DUMR/i28H J M MU MD J Si 

& S2 z R PHll CURV 

S RHS DS2) 

1201 Format (ix* IB.SiS, 12,2ril,6;2P12;6,fll,6.Fl2,7,2F11.3,2FlO;5) 

1202 FoRMATdH ) 

Return 

End 


TA9LES{t),LNE*Tci7,MLB(i),MUB(97) 

B(300) 

CURV(300) 

DS2(300) 

Ml JiMUiMOdSTAG 
LINES, 0MlTFK,PTiTUE|6> 

OMITFK 

JMS(300) 

PHIK300) 

R(300) 

RW5(300) 

Sl(300) 

32(300) 

IITAB 

VM(300) 

2(300) 

LhO.LHE, LBDO^LbDE, LTO.LTe; LwO,LWE, LF0,LFE, 
L0,LESTA,LS0,i:SB,LDUM(6). 

MOiNM, NJrNFCOLSi MAXNU.MAXOL, MAXNM, MAXLE, 

LEO, lee, LROiCRE.URD 


V 
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•DECK ERRORK 

Subroutine errork(na»ie> ..-no* rAui 

Common /AlLCOM/ MACHA#PSA.TSA»PTAiTTAi AXIA.RGAiGAhAi 

MACHCiPSC,TSC;PTCiTTCi AXlCtRGCiGAMCi 

daxit.scalea.tte.chotst 

MACMA(l) iHACHC 
AXiAi AXIC 

chotst 

AREA<96) »AR6A0t96>iDlSPt96> .PT(96) .UAMBDA(96 » , 

1 rH 0{96) iSQRtVVl(96)iTS<9A> iTT(96) iVMSQ<96J I 

2 VVKQkP{96)i , 

2 WQA( 96) |WSTA(96K RG( 96 ) i C2CP < 96 > i FGR < 96 » 


REAL 

LOGICAL 

LOGICAL 

COMMON /ERASB2' 


C 

C 


REAL 

DIMENSION- 

EQUIVALENCE 

dimension 

EQUIVALENCE 
FIELD tables 
INDEX- MsMOiNM 


LAMBDA 

ES2<96) |SDNQRa(96) 

tES2i VVKQKP)* eSONQRMiRHO) 

RCUI96) 

(RCUiLAMBDA) 


Common /cz / Z(300) 
COMMON /CR / R(300) 
common /CS2 / S2(300> 
common ''csl ^ SK300) 
COMMON /CPHll / PH1K300) 
common /cm / JMS(300> 
COMMON /CCURV / CURV(300) 


C 


/C8 / 
/CRHS / 
/CDS2 / 
/CEDUMP/ 
/CIOEX / 


B( 300) 

RHS(300) 

DS2(300) 

iqOdmp 

M, J,MU,MD, ISTAQ 


COMMON 
COMMON 
COMMON 
COMMON 
COMMON 

table of index limits 

COMMON /IxORtG/ LHO|LHE| L0DO»LBDE| 

» LOiLESTAi LDOMiBTi 

» MOiNM, NJ.NFCOLS. HAXNJ ,MAX0 L .MAXNM i MAXLE i 

• LEOiLEEi lro»cre»lrd 

DIMENSION LIMITS(24) 

EQUIVALENCE (LiMiTSiLbO) 

COMMON /CVM / VM(300) 


LTO.LTE, LW0,LWE, LFO.LFE, 


C 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


streamline table . „ » 

Common /slTab / w( 12B) ,x2<i28i.sLCHNU28) 


integer SLCHN 
boundary table 

INDEX- LBaLBfiOiLBDE 

lbnexts increment to next Boundary „ . 

increment to the first boundary POINT (sO BEFORE COAlLATIO 
channel with WHIcB the boundary data is associated 

T OR F FOR UPPER OR LOWER BOUNDARY enorAPP 

relative INDEX OF L'.EV POINT WHBN LOWER AND UPPER SURFACE 

Contours are connected 
BDNAMEiLBA.LBB«NAME and index limits OF SPECIFIC BOUNDARY 
data when boundaries are COALLATED 
dimension BDTd) ,LBNEXTm,L8Zl(l>, 

1 CHNAME(1).UP(1)VLEDEX(1)i 

2 ZBT(X) »RBT{1)»ANGBTI42) 


LBZl 

chname? 

UP ? 
LEOEX b 


LOGICAL UP 

INTEGER BDT^CHNAME.BDNAME 
DIMENSION BDNAMElD.LBAeij.UBBll) . 

equivalence (BDnAMEiZBTI* (l'BAiRBT)i 

FLOW ADJUSTMEST TABLE 


(LBBiANQBT) 
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c Index- lfslfo.lpe 
C NFCOLSs 8 

XiF ■ orthogonal coordinate 

X2F a streamline COORDINATE Of SU EMInaTING FROM T,e. 

XlBF a XI-COORDINATE OF CHOKE STATION OF FLOW BELOW T.E. 

XlAF a XliCOORDiNATE OF CHOKE STATION OF FLOW ABOVE T,E, 

SlF a SliCOORDiNATE OF T'.B. (UPPER SURFACE). THIS ITEM 

IS USED When interpolating for wake delta^star, 

LFB.LFAaiNDICES OF STATIONS BELOW AND ABOVE T.Ei 
NCHBiNCHAaNUHBER OF CHANNELS BELOW AND ABOVE T.E« 

LRF a index of nUMMT ORTCHN LfST FOR THE T.E. 

lrxf a Index of last channel below the t-e’ 

JORDERs 0 IP total FLOW AT XlF IS GIVEN 
a 2 IF flow above T.EI IS GIVEN 
» 1 IF FLOW 3ELQW T,E; IS GIVEN 
JORDERa -1 IF FLOW AT XlF IS CHOKED AND SINGLE CHANNEL 

Dimension xifid •x2F(i)«xiBF<i) ixiaF(d , 

1 SlF(l) ,NCHBa)iNCHA(l)i JORDERdli VNR(12) 

equivalence (LFB.XiBF), (LFA;xiAF>, (LRF,NCHB>i (LRXF.NCHaI 
DIMENSION LFB<1) iLFA(l ) .LRFU) .LRxFdJ 

station Table 

INDEX- LaLOiLESTA 

SCHOKEa STATION CHOKE INDICATOR ( ADjWF , bRHS ,‘WR 1 OUT ) 

mcl a SHARP Corner indicator ibldtbs) 

mcl a Field index of control streamline (ptmove.flobal) 

common /ChDATA/ xid) .LNEXTdJiMLBd) iMUBd)*PRlMd> I 
1 TYPEtB(l),NAMBLBd),ILBd>#FLB(l),SlLBd)i 

1 TYPEU8(l),NAMfiUB(l),IUB(l>,FUBd) ,SlUB(i). 

3 VM8(l>iDWDV(lJi X2CL(l)VvCLd).MCL(^81> 

LOGICAL PRIM 

DIMENSION SCHOKEd) 

EQUIVALENCE ( SCHOKE 1 DflDV ) 

EQUIVALENCE ( BDT , XlF , XI ) , (LBNEXT, X2F, LNEXT ) , ( LBZl , XlBF 1 MLB ) 
equivalence (CHNAME.XIAFVmuB) . (UPiSlFiPRIM) 
equivalence (LEDEX.NCHB.TYPE^B)i (ZBT.NCHAiNAMElB) 
equivalence (RBTi JORDER. IL8) ( ANGBT .VNR.FLB) 

COMMON /CTABRR/ llTAB 

WRITE (6»iool Name 

100 FORMAT! //2X,’13HERR0RK CALL--. lAft//) 

CALL TABPRT<6HALLC0M,MACHA,20;8) 

IITAB a LBDO 

Call tabprti6HBdvt^b.bdt . iBOEisi 

ll^AB a lfO 

Call TABPRt(6HCADjWF,XlF,UFE.8) 

UTAB a LO 

Call TABPRt(6HSTATA8,XliLESTA,5> 

150 write (6,1150) (J,X2( J),SLCHNCjj,W(j),Um,NJ) 

L a LO 
LMAX a LESTA 
180 OMITFKr .TRUEi 
LINES a 64 
190 Ma a MLB(L) 

MB a MuB(L) 

CALL FHEAD(M|-MAT2) 

If (LINES:e07(MB-MA*5> ) write (6.1290) 
write (6;'i201) 
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DO 200 MbMAi'HB 
call GETlx 

write (6,1201) JiMiHUtMDi ISTAS. Si { M ) i S2 ( M > . Z C M ) i R< M ) , PH 1 1 <M ) , 
1 CuRVfM>»‘VM(M>»B{M)»RHS(M)*DS2(M) 

200 CONTINUE 

L « L*LNeXT<L) 
if(l»le,lmax1 go to 190 


c ERASE 2 Dump 

300 NK S MIN0^NK,96) 

GO TO (400V310.330|350,360) VIGOQMP 
310 write (6.1000) 

DO 315 

write (6,1001) (AREA( J) , JTl ;672V96) 

315 Continue 

write (6,1002) 

DO 320 1*1, NH 
IP s 672*1 

WRITE (6,1001) (Ar£A( J) i J»lp, 1536|96) 

320 Continue 
GO TO 400 

330 WRITE (6,1003) 

I « 0 

L » LNEXT(LO) 

Do 335 lLaLO»LEsTA»L 

I * 1 ♦! 

WRITE (6;i001) (AREA(O), J#!;768';12$) 

335 continue 

write (6,1005) 

Do 340 lai.NK 
IP * 768*1 

write (6,1006) (AREA(J)iJf lP;i248,96> 

34o Continue 
Cq to 400 

350 WRITE (6,1007) ( ARE A ( I ) , I *ll52, 1 183) 

write <6;ioo9) 

I a 0 

L * LNEXT(tO) 

Do 355 iLaLOitLESTAiL 
I a 

WRITE (6;i01fl> ( AREA(j),J»i;il5a.l28> 

355 continue 
GO TO 400 

360 write (6,1011) (Ar£A(I ),I»1024,1037) 

WRITE (6,i0l2) 

I a 0 

U a LNEXTtLO) 

Do 365 1L8L0 «clESTAiL 
I a 1*1 

WRITE (6.1013) (AREA(J),JiM;i824,l28> 

365 Continue 

400 continue 

4000 Format (//2X»40hsi’3routines brhs, flobal. wribdy, wriout// 

1 11X;4HAREA,8X,5HAREAO,9x,4HD1SP;i1X.'2HPT,7X,6HLAMBDA;ioX# 

2 3HRH8.7)(,6HSaRTVVl 
1001 Format (2x*’6i3;5) 
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iOOJ? format 
1 

1-003 Format 
1 

1005 Format 
*00* Format 

1007 format 

xoov Format 

i 

1010 Format 

1011 format 
1 

1012 FqrmAt 
1 

1013 Format 
1202 Format 
1201 format 
1200 Format 

* s2 
•Vm 


<//13X,2mTSiIIX,2HTT;9X.4HVHSQi7)(,6HVVKQKP»10X,3HWQAi9Xi 

4WWSTA.liXi2HRG,9X,4HC2ePrlOX.3HFQR> 

(//2Xkl7MSUBR0UTlNE PTHOVE// l^X,3HXlL,llX,2HSC,tlX.2HVC 
10X.BHVDS.9X,4HFvDs;iflX;3HSCX) 

(2x.4e13,9,5x,l2) 

j//2X»l7MSU8R0UTlNE REF Ine// 2X|3HIA« , 16 l7/2X#3HlB»i 1617 > 
‘//13*.2MCR,9X,4HDELS*8X;5HDELVM,2X,4HLSTA»3X.3HMJ2,lflXi 
3hSQX * lOX . 3 hsG Y » 10x; 3RRAV I lOX I 3 hZ AV J 
{2x*3ei3,5i2I6»4El3'.5) 

(//2X«i4hSUBR0UT|Ne SLC//2X, 6HCURSS#;6E13 , 5/ 

ZX.’AWQV =,8E,3,5) 

(//13X.2HR0illXi2HZB;iflx'»3HANGi8x*9HCuRVBil-OX*3HslB,lIXi 

2HBlx2X,dHJ20ONE,3X;3HMSV» 

(2xV«ei3.9.2Xi2!6) 

(IM ) 

(lx* *3|3I5, l2,2Fll,6;2Fl2.6,Fli;6,Ft2,7,2Fll,3,2riO;5| 

(57X,16HFIEID TABLE 0URP/128W J M MU MD I Si 
Z R PHIl CURV 

B RHS DS2 > 


V 


LSTQP « 5 

lF(LSTOP;BO;f) STOP 

return 

U50 F0RMAT(///iXl7MSTREAMUINE TaBLE;/17x32h J X2 SLCHN 

* W/{Ii8;f12;6«6XiA6,P12;6, $. J 

END 
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•DECK AtAn3 

FUNCTION aTA«3IDV,DX,ANQREF> 

•ATaN3« aRCTaN function with R6FER6NCE ANGLE PATAN3* 

c LIKINS AREi (bPm ’.lc’. < aTan3«anqref ) ;lt; <*P1) 

COMMON /CaTa"3/ Da'^Q 
COMMON /CPI / PliTWOPl 
DATA KNAmE/6HATAN3 / 

ANG s ATANaCDY.OX) 

N s 20 
50 N s N-j. 

if<n,eq;o) call brrork(knaMe) 
oanq • ang-Angrbf 
1F(PUDAN8) 60*y0»70 
60 Ang ^ AnQ'TWOP! 

GO TO 50 

70 1F(DANG*PI) 60i9fli90 
80 ANG B ANG*TW0PI 
Go TO 50 
90 ATaN 3 e ANQ 

return 

end 



OCIOOOOOOOO O OO OOOOCJ OOCl 


•DECK BARC 

SUBROUTINE BfcRCd) ^ 

•BARC«« BOUROARY INTERVAL CURVALINEAR OIST PBARC# 


INPUT* 

BDY • boundary TABLE OF Z,*R»AnQ 
I s Index or coor-z relative to bdy-table origin 


output, 
dr 8 

GZ s 

DX 8 

YPA 

YP8 » 

SlNTVLi 


dbltr-r • 
delta*z • 

CHORD CONNEC 


R< IV*1)»R{ IV) 

“"V)^ 

POINTS OF the interval 


delta*z • z(ivjj)»znv) 


CHORD connecting THg POINTS OF tHE INTERVAL 

angle Relative to the chord, point.iv 
angle relative to the chord, POlNT-lV^l 
CuRVAlInBaR distance bEtwEEn POINTS Iv,lv*3 


oilNTVUa wuKV»U*l>l«Mr% 

L ALSO-YPASO*'^PBSQ,TpAB) 


boundary Table 

INDEX- LB3LBD0*LBDE 

LBNEXT« increment TO NEXT BOUNDARY 

Increment to the first boundary point (bq before cqallatio 
channel with which TH0 boundary data is associated 
T or F FOR upper or LOWER BOUNDARY „ - 

relative index or l'.e; point when lower and upper surface 

CONTOURS ARE CONNECTED 

BDNaHE.LBA.'LBB'NAME and index limits of specific boundary 

data when Boundaries are cqallated 
common /CHDATa/ BDT(l) iLBNEXTtli ,LBZ1(1) , 


LBZl • 
CHNAMEb 

up » 

LEDEX 8 


1 

2 


LOGICAL 

integer 


dimension 
equivalence 
Common /cbeamz/ 

LOGICAL 


CHNAME(1).UP<1)»'LE0EX<1). 
Z0T|l>,RBT(l)';AMQBTf42) 

UP 

BDT^CHNAME.BDNAME 


BDNAMEa>,LBA|l)iLBB(l) 
tBDNAME,ZBT)» JLBA iRBT). (LBB.ANQBT) 
DRiDZ»YPA,YPB,F,Q» DXi YQDXi ZM# RMi A nGMi CURVMi S lM* 
RZONLY, ANGCHD.SINTVL, yPASQ, YPAB, YPBSQ 
RZONLY 


DZ A ZBt<T*3)-Z3T( I > 

Dr s RBt I 1 ♦3 )-rBTU > 

Dx « sort{dz«dz*dr*dr> 

IF(Dx.EQ,o*. > GO TO 90 
ANGCHDs ATAN3(DRiOZ.ANG9T(l)) 

YPA » ANG8T( 1 )-ANGCHD 
YPB . q AnGBT( i*3)«angchd 
YPaSQ 8 YPA*YPA 
'''PAB P YpA«VpB 
YPBSQ P YPBtVpB 

90 SINTVLa Dx*<i* * ( YPASQ* • 5 *VPKB*YPBSQ> / 15 » ) 
RETURN 

End 
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•oecK barcs 

FUMCTION BARCS^NAME, ivi# 1V2) 

•BARCS. ACR distance BETWEEN BOUNDARY PTS PBARCS* 

input- 

name B bounbarv name 

Ivii I vZpInDEI Of POINTS IN THfi QlyEN BOUNDARY 


C 


C 


C 


boundary table 

INDEX* LB»L3D0.LBDE 

lbnext* increment to next boundary 

LBZl » increment to THE PIRST BOUNDARY POINT (sQ BEFORE CqAlLATIO 
CHNaMeb channel WITW WHIcH the BOUNDARY DATA IS ASSOCIATED 
UP e T OR F FOR UPPER OR LOWER BOUNDARY 

LEDEX ■ relative index Of L*.E; point WHBN LOWER and upper surface 

CONTOURS ARE CONNECTED 

BDNaMe,LbaVL;B8pNaHE and index LIMITS Of SPECIFIC BOUNDARY 

data mhen Boundaries are coallated 
Common /chdaTa^ aoTai , lbnext(i»,lbzi(U. 

1 CHNAME(l)iUP(l>7LEDEX(Xl • 

2 2BT(1)iRBT|1);anGBT|42> 

LOGICAL UP 

INTEGER BOTvCHnAMEiBONAME 

dimension 8DNAM£<l),L8AflULBB(l> 

EQUIVALENCE (BDNAME i ZBT I « ILBAiRBT). (LBB<ANQBT> 


^COMMON /C9EAR2/ 
LOGICAL 

INDEX. MshOi'RM 

Common /ci / 

COMMON /CR / 

common /CS2 / 

COMMON /csi f 

Common /cphiI / 

COMMON /CM / 
COMMON /CCURV / 
COMMON /C8 ^ 

COMMON /ClDfil / 


DR,02,YPA,YPB;r;G, DX,YflDX,ZM,RM,ANGM,CURVM|SlM, 
RZONLYi ANQCHDiBINTVLi VPASOiYPABiYPBSQ 
RZONLY 


Z(300) 

R(300) 

S2(S00) 

SK300) 

PHlt(300) 

JMS(300) 

CURVI300) 

B(300) 

J«HUiMO*ISTXG 


index in /bdvtab/ 
LB ■ LBFISaMEI 


c SUM the arc distances for intervals IVl TO {1V2.II 
I = LB*L8ZllL9U3*<lVtil> 

IF( ISTAQ.EQ.*) Ifl*3 
ISTOP ■ U3*^IV2«IV1) 

s ■ o'. 

75 IF( I-iSTop> 8B;90»90 
“0 CALL BARC(i) 

S • S*S1RTVL 
^ ■ U3 

GO TO 79 

90 Barcs • s 

Return 

End 
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•DECK beam 

Subroutine b6am(X.y, anqiN) 

•BEAMif routed cubjcs similKtIng a beam pbeamp 

c riT TO Coordinate rotnts 

01 mens j ON X(IOO»*Y(10O)iANQaflOi 

input- 

XiY i COORilNATES or ROINfS 

ANG b EStlHATlD ANQUE At tHfi QlVEN POINTS,' RADIANS (MAPIT 
ANGIDi EStiHATBD ANGLE AT THE HRST POINT (MA«0) 

N 8 number or POINTS 

MA 8 0 if THE VALUES Of ANGLES ARE NOT ESTIMATED# 

A 1 If ESTIMATED ANGLES ARE GIVEN 
MB 8 NO Of iterations 

KD n STORAGE INCREMENT Of X*Y#ANG 

KoRDERi 0 IF ERRORl IS TO BE CALLED WHEN PTS ARE OUT OF ORDER 
« mi TO SKIP THE POINT ORDER CHECK 

1 '.QE’.l If RETURN fS To BE MADE FOR CORRECTIVE ACTION 
<1F NOT input MAAO, MBbI, KD*1, AND KORDERbO) 

Subroutine bend Must be provided to calculate the following coeffi 

A(2|i) ,A<3,1) ,B(1), Ael.'N) iA(2,n) #B(N) 

output,. 

ANG ^ CALCOlATBD value Of THE CURVE ANGLE.’ RADIANS 

B 8 SLOP! In rotated coordinates# left end of segment 

YPB A Slope in rotated coordinates# right end of segment 

ACHO a ANGCE (RELATIVE TO HORIZONTAL) OF THE LINE SEGMENTS# RAPlA 
CHO A lengths of the line segments between the input POInTSi cho 
' KorDErr InOGI of 2ND OF ADJACiNt OUI-OF-ORDBR PTS# NOTbQ On ENTRY 

NOTe-COMMON. /ERASE/ MUST BE 8«N fN LENGThI ITS LENQTH MAY BE CHANG 
C By A SUSE CABO WITHOUT PROGRM RECOHPILATION! 

C ORDER Of STORAGE IN COMMON /ERASE/ IS - AU# 3) , A ( 1 # 1) lA ( 1 , 2 ) # B< I ) # 

C YPB(l),DA(ll.ACHD(l),CHDai# A ( 2, 1 » , A ( B , 2 ) ‘,A ( 2, 3 ) , B ( 2 > # YPB ( 2 ) # DA ( 

COMMON /CAtA»3/ DaNG 

COMMON /CBBAM / MA#MBiKD#K0RD6R 

COMMON /CPi ^ PI#PIDUM(5J 

COMMON /ERASe / A ( 3 ) # B ( 1 ) f YPB(U , DA( 1 ) # ACHD( 1 ) # CHD ( f 93 ) 

dimension YPAUOO) 

equivalence <ypa#b) 

Data kname/awbeam/ 

IF(N,LE*.1) CIlL BRRORK(KNAME) 

M i MA 

N8 ^ 8aN«f 

C CALCULATE THB CHORDS CONNECTINQ THE GIVEN POINTS 
C AND CALC fHB TURNING ANGLES BETWEEN SUCCESSIVE CHORDS 

K pi. 

I R 1 

^M8 r 1 

ACHO(i)RANQ(i) 

100 Kp 8 k*KD 

SX 8 X(KP}aX(K) 

ST R Y(KPI-Y(K) 

®M) e AnQ(K) 

CM0(I)R SORT^SXtSXBSYPSY) 

ACHD(I )iAtAN8{SY.SX#ACHDi!M8) J 
da(i ) 8 dang 
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« <ABS(DAn))*ABS|DA{lM8M».GT,PI 

• KORDERiNE.(*l>> GO TO *00 
13Q tM6 B 1 
I B U8 
K ^ KbKO 
irn-N0) ioo«i4o»i40 
140 ACHD( I >bacH0< I»8 ) 

DAU) » O'. 

BfP 4 aNQ(M> 


.AND, 


SLOPES IN the rotated COORDINATE SYSTEM 

^ROM the esttmated input angles 
1 ¥ 1 

ir(M) 160.*l80.l6fl 

160 YPa(I) 5 TAN(B(I)-ACHDm) 

'^PBn>t tan<B( i*8)«ACHDn )) 

I a 1*8 

IF(I.N81 i60«200i200 


180 

185 


l9o 


Slopes Equal to a fraction of the line segment turning 

YPAIDb ;:2*6A<9» 

I If 9 
YRB(I-8Is'.4‘>BAM ) 

YPAII )e iYPBO^Sl 
I P 1*8 
IF11-N8) i83kl90»190 
YPB( I.8j,*2«BA( I«8) 


c end equations 
200 call BEND(N) 


Matching angLe and curvature equations 

^ lF(N-2) 250*800, 230 

250 I .9 

GO to 260 

255 A{|) B CHD(n*a,4l,5*yPA<I)#YPA<n> 

A{ J*2)s CHD( N8)*(i;*l,5*ifPB( Ib8)*YPB( 1.8) ) 

A<l*l)f 2;*{A(1 hA(I*2)J 

BID ? )*DA<I) • A<1*2)*DA< 1*8) 

I P I *8 

260 1F<I»n 8) 255il300,300 


routine TdsEQ " TRIOIAGONAL SIMULTANEOUS EQUATIONS 

SOLUTION TO AXbB, on RETuRN SOLUTION VECTOR X IS STORED IN B 
300 A(3) b A{3)/A(2» 

S<1) a B(l)/A(2) 

I b 9 

Special Logic for aii,3» 

A(l) B A(l)/A(2) 

A(iO) B A(tO)sA(9)«A(3) 

Adi) B (Adl).A(9)aA(i))/A<$0) 

, „ 60 TO 312 

310 An*l)8 A( I*l)*AU)*An-6I 
A{I*2 )b A( I*i)/All*l) 

312 0(1) * (B(I i«A(I )»9(I«8) I / *|i*l) 

I « 1*8 
IF(I-N8) 310b320,340 

special logic for A((i,N-f) 

S20 A(I) B A(h-A(I*2)»A(I-14) 

Bd) e Bd dA(l*2)*B(I-i6l 
GO TO 310 
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c Back substitution 

340 \ 8 MS 

390 I B 1-8 

IECl-l> 400.355,560 
C special logic fOB A(l»li 

355 8(1) • 8<ii-Aa>«8(lTl 

360 Bi\) • B<i )*Al!*2>*Bn45J 
GO TO 390 

c Reevaluate tPb 

400 ! 49 

405 YPB< I-8>* B< ! >*DA< I » 

I s 1*8 

IE'(1.n8) 409«409«490 

c return for another iteration 

450 M ■ M*1 

200«200»900 

C angles 

500 I a i 

K A 1 

9Q5 ANQ(K)a acHD|I)*ATANIB(I)I 

I « I«8 

K « K*KQ 

1F( !-N8)505i905,'530 
530 KORDERp 0 
GO TO 900 

c Error r out of qRoEr points 
800 ifikorder'eq7o) Call errorkiknamei 

KOROERi K 

900 RETURN 
END 
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•DECK CBEAH 

Block data beambk 

•CBEAM* data roR /CBEAM f •CBEAM* 

COMMON /cbEAH t MAiHBiKOiKORDER 
DATA M A I MB * KD . KORDER/ 0 1 1 * t « 0/ 

End 
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•DECK BBND 

Subroutine bbnd(PIn} 

•BEND., gNQ conditions FOR THE BEAM Fit PBENDH 

ON entry ; ' 

N ■ NUMBER OF FOINTS 
ALSO OeriNBf ON ENTRY c |N CQHMON/CBEND/ " 

NBCa>« BOUNDARY CONDiTlOS INDICATOR Fqr LEFTa®l> AND RlQHTtU*B) 

V OV i« OR 2 

ANQEdlSANQLl IN 0EQREE8 IF NBC(L>»1 
C0RvE(LUCuR»ATuRE if NBC(l>»2 

fbnd(L)i ratio of shear of the end to Next to end interval, NBCti) 
c ON RETuRNi 

c OOEFFlClENtS ; At2),A(3),B(i) AND A < NS ) i A (N8*l ) i B ( N8 ) 

COMMON /cbEND / N8C(2),AN8E(2i,CURVE(2),FENO(2) 

COMMON /CRI / Pl,THOPl,Rl02;P!04,TODEfl;TORAD 
CQiiMON /ERA96 / X ( 3 ) |B (1 ) «YpB M I . DAf D i ACHD (1 ) , CHD ( 793 ) 

c initialize 

N f NN 

c N8 R index fqr risht eso point 

N8 r 8«N.X 

Atu p o; 

AC2) • i; 

At3) 1 o; 

AtN8> P 0, 

AtN8*l)Rl 

ASN8*2)p0. 

C A STRAIGHT i^IflE I8 USED FOR N»2 IF MBCm>NBC(2)«0 
NBCS a NBC(1)«NB6(2) 

IF(N,GT;2 .OD; NBCS;qT,0) go to 80 
BtU R 0*. 

Bt9) R o; 

BC2) r o! 

QO TO 900 

c check if parabola <F« 0 ) should be used 

80 IF(N,EQ;3 *.ABo; NBCSiEQ’.O) GO TO 9Q 
Ft 9 FENDED 
F8 • FBND^2) 

GO TO 110 

90 Fx p o; 

F2 a 0 . 

C NBCsOi. Y AND ANGLE SPECIFIED 

0 LEFT END 

UO inNBCtll'.NBTOl) QO TO 120 

Beil r tAN(tORAS*ANQE(l)aACHD({}) 

C RIgHt BND 

120 IF(NBC(2)'.NE?01) QO TO 210 

BtNS) R TANft0RADiiANQE(2)aA0HD(N8n 

c nbcro2,‘ y and curvature specified 

c le^t end 

2X0 lP(NBC(t);NS702i QO. TO 220 
A(2) r 4i 
A{3) 9 ?* 

sen R •S.R0A(f UCHD(l)«eURVS(i)«(l.«i;9«B(l)ftB(l)) 

C RIGHT END 



220 IF(NBC<2) )NS702» QO TO 316 
a?N8) • 2. 


BlNSl‘{*;iHD<N«.»>»eURVEl2l*<lUl.»»''PB'NB.»l*''PB(N6.en 


N8C*0i • ^ • YPPPtOf adjacent INTbRVaL) 

; left end 

3X0 ir(NBCtf)’,NE70) 60 TO 320 
lF(NiEQ*2) 60 TO 319 
DXlSQ 9 CMDtl>*CHD<l| 

DX280 « CMO($ >«CMD(9» 

A(2} 9 DX2SQ 

■ iFl*DXlSO 
A(3) 9 A(2)9A^1^ 

BU) 9 Fi90*<17»*0XlSQ • DA<9)»DX2SQ 
GO TO 320 

315 A(3» a i; 

0(1)^ 9 0. 

c right end 

320 lriNBC<2)*NE70» 60 TO 900 
IF(NiEQ‘. 2) 80 TO 325 
DxNSO a CHD(R8"a>*CHD(Nfl-i8) 

DXMSQ 9 gHD{N0»l6)»CHD<N8»16> 

A(N6*2)9-r2*®XNSQ 

AtN8*l)»DXMS6 

A(N8> ® A(N8»1>*A<N8*2) 

6<N8) a raaO*(N8i8)9DXNSQ 
GO TO 900 
325 A(N0) 8 ij 
B(N8) s 0, 

900 return 
End 
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•DECK CBEND 

block data BEigOBK 
•CBEND. data for /CBEND / 

COMMON /CBEND / NBC(2) iANGE(2)iCyRVE(2) ,FEND(2) 
data NBCi ANQ 8tCuRVEiFEND/2«0*6«Q</ 

ENq 


rcbend^ 
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or* o o o o oo oo ooooooooo 


•DECK eri 

Subrout iNe afi 

• 8 ^ 1 — • BEAR F!T INTERPOLATION PBri* 

INPUT* 

DR R(!* 1 >*RIP 
D 2 • 

ypa ^ angle Relative to the chord, pointbI 

YPB « angle relative TO THE CHORD, POINT, !♦! 

I • X/DX 

® • (bx»i)/ox 

RZONLY* T If YOOX, RM and Z6 onlt are to be computed 


output data at the intermediate POINT within the interval 
yqdx s y/dx» distance normal to the chord 
zm » zizit) 

RM « R-R(I) 

Dx S LENGTH OF THE CHORD 
ANGM s ANG*RnGCHO 
cuRVM 8 Curvature 

Sim s curvAlinear distance from point-i 
notes* 

Chord a line between points i and ui 

common /CBEAH2/ 0R,0Z,YPA,YP8;F';G, DX,YODX,ZM,RM,ANGM,CURVm,SiM» 
^ RZONLY 

LOGICAL RZONLY 

Double precision ci,C2,C3.C4»G5 

YQdX 8 F*G»<G*VPa*F»YP8) 

RM « YGOX#DZ*F*OR 
Zm F*DZ*YQDX*DR 

IP(RZONLY) go to 990 
OX 8 SQRT<dR*DR^DZ»DZ) 

ANGM 8 YPA«*3;*G-2‘, >*G ♦ YPB«< S>F82, )#F 

CURVM » (VPA*(6>G8*i>*YpB*C*6i*F*2,) >/(DX*a,*l,5*ANGM*AN6Mn 

YPASQ 8 yPAaVPA 

YpAB « YpA*VpB 

YPBSQ p YpBfVPB 

Cl a l.*.f«YpAsQ 

C2 8 ;2*,«ypaso*ypa8 

C3 s (ii;«<YpAS3*TpABI * TpBSO^TPBSQ ) /3 , 

C4 a iJ^VpASO • A.5#YPAB - iiSpYpBSO 
C 5 a 9«*(TpAsO*YPA9*YpAB*YPB8Ql/A0< 

SlM 8 DX*<r*(Cl*F8<C2*F«(C3«F»(C4Tr»C9)))>> 

990 Return 
End 
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•6ECK CBFI 

block data bPiblk 

•CBrin- BL08K DATA FOR BC! •CBFI* 

COMMON /C8EAH2/ DR , DZ i TPA.YRB^F'.’G, DX , YoDX ,2M ,RM , ANGM , CURVM iSlM* 

1 rzonly 

LOGICAL rzonly 

DATA RZONLY/TfALSEiV 
CNQ 
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•DECK CPTIME 

Subroutine cptimB(Time) 

Return iai200)#dum(i3367 

end 
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•DECK FHEaD 

Subroutine rHEADtuAi) 

CfHEAD-.-- CDC VERSION 

COMHON /ADAMSI/ N A'IE < 6 ) , ADDRESI 6) i T I TUE( 6) i 1 DEnT ( 6 > 
COMMON /CLINES/ LlNeS»QMITrK»PT!TLE46) 

COMMON /LiNMilX/ LMAX 

La « Lai 

C ADJUST LINE COUNT 

5 LINTOT® L1NE8*LA 

iF< lintot‘.qt;lmax ) go to 8 

LINES 8 LiNTflT 

6 RETURN 

c Restore and f*«iNT ioentihcaTiOn ir line count. gt.lMax 

8 write <6,810J TlTLHiRTITLEiiDENT 
LINES q LA*3 
GO TO 6 

810 roRMAT(lHlV6AlOi33Xi6A6/lX,6AlO> 

End 
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• ♦ 


•DECK GETIX 

IOENT GETIX 
ENTRY GBTIX.SAVIX 

• subroutine GETIX 

• COMMON /CM / JMS(300> 

• COMMON /CIDEX / M, J.MUiMD, ISTAQ 

• INPUT- 

• jms = aRRay containing packed indices jVmu.md.istag 

• Ms Index of -jms» array 

• OUTPUT- 

• u * streamline number 

• MU s M"^ upstream 

• MD s m* downstream 

• istag s indicator for stagnation point* etc* 


GETIX 


BSSZ 

1 




SAl 

M 

CONTENTS OF M IN Xl 



Sa2 

X1«JMS.1 

JMS(M) IN X2 



Sb3 

0 

Initialize 



SB4 

3 


LOOPG 


Sa3 

MASK1*B3 

load mask 



BX6 

X2*X3 

AND TO mask 



SaI 

SHIFT*b3 

SHIFT BITS IN Xl 



SB5 

XI 

move to B5 



AX6 

X6.B5 

SHIFT 



Sa6 

J7B3 

STORE 



SB3 

B3«1 




LE 

a8.B4«L0OPG 




JP 

GETIX 

TRA FOR return 


subroutine saviX 



input- 




M 

= 

index of jms 

array 


J 

3 

streamline number 


MU s 

M- upstream 



MD S M* downstream 

istag s indicator for stagnation point* etc. 
output- 

JMS{M)s packed J»MUiMD, istas 

SAVIX BSSZ 1 

Mx3 0 

sb3 0 Initialize 

SB4 3 

LOOPS Sa2 BD*J J in X2 

SaI SHIFT*b3 

SB5 XI 

LX2 Xa,B5 SHIFT LEFT 

Bx3 x3*X2 OR TO X3 

SB3 b3«1 

LE B8,B4iL3QPS 

SAl M 

BX6 X8 MOVE TO X6 

Sa6 x 1*JMS-1 STORE iJMS(M) 

Jp SAvix t'ra for return 

MASKl Data OOOOOOOOO776OO0OOOOO8 

DATA Q00000000001777700008 
DATA 000000000000000077774 

Data oooooooooooooqoooooos 

SHIFT data 28 

DATA 15 
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Data 

2 


DATA 

0 


USE 

/Cm/ 

JMS 

BSS 

3Q0 


USE 

/CIDEX/ 

M 

BSS 

1 

J 

BSS 

1 

MU 

BSS 

1 

MD 

BSS 

1 

ISTAG 

BSS 

1 


End 



•deck getrlx 

I dent ge'trux 
Entry getrlx 


GETRL^ 

BSSZ 

1 



Sb4 

29 

INITIALIZE REGISTERS 


Sb7 

•5 


LOOP 

SB7 

87*5 

INDEX 87 

I.00P2 

ge 

87, B4. getrlx 

SaI 

87*M 

CONTENTS OF M IN Xl 


Sa2 

Xl+JMS-1 

JHS(M) In X2 


Sa3 

HASKl 

HU-MaSK in X3 


BX6 

X2ttX3 

EXTRACT HU 


SaI ' 

SdiPT 



Sb3 

Xi 

shift bits 


AX6 

X6.B3 

SHIFT RIGHT 


Nz 

X6,UP0 

test for streamline origin 


Sa4 

M 

M<= TO 

upo 

6X6 

X4 

MOVE TO X6 

Sa6 

B7*MU 

STORE CURRENT MU 


Sa3 

HASK1*1 

MD:5MASK in X3 


BX6 

XJ*X3 

EXTRACT MD 


SaI 

SWIFT*1 



SB3 

XI 

SHIFT BITS 


AX6 

X6,B3 

SHIFT RIGHT 


NZ 

X6,DnG 

TEST FOR streamline TERMINATION 


Sa4 

M 

M* TO X4 

dno 

BX6 

X4 

MOVE TO X6 

Sa6 

B7*MD 

STORE CURRENT MD 


Sa3 

MASKi*2 

istag-bask In x3 


BX6 

X|«X3 

extract istag 


Sb6 

3 



Sb3 

X6 

MOVE LOW ORDER BITS TO B3 


NE 

B3, 86, NOTPO 

TEST FOR PARTIAL ORTHOGONAL 


2r 

bj.notpo 

BRANCH ir MID-POINT 


Sb3 

5 


Eq 

83, B7, UPPO 



Sb3 

15 



EQ 

8a, 87, UPPO 



Sa4 

B7*MD 

CURRENT MD in X4 


Bx6 

X4 

MOVE TO X6 


Sa6 

B7*M 

RESET M TO MOVE RIGHT 


JP 

L'80P2 


UPPO 

SA4 

B7*MU 

CURRENT MU IN ^4 


BX6 

X4 

MOVE TO X6 


Sa6 

B7*M 

RESET H to MOVE LEFT 


Jp 

L00P2 


NOTPO 

SB3 

15 



ge 

B2,B3*LOOP 

CONTINUE IF ON EXTREME{M2,M6> POINTS 


NZ 

B'lTESTl 

CONTINUE CHECK 


Sa4 

HU 

Mu In 84 


8X6 


MOVE TO X6 


Sa6 

Hf5 

SET UP FOR M3,m5 


Sa4 

MB 



BX6 

X4 

MOVE TO X6 


Sa6 

MtlO 



Jp 

LOOP 


TESTl 

Sb3 

5 



ne 

B7,B3iTEST2 
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Sa4 

bt*mu 

SET UP M2 POINT 


BX6 

XA 

MOVE TO X6 


Sa6 

M<15 


TEST2 

JP 

LOOP 


SA4 

BO + MD 

SET UP M6 POINT 


BX6 

X4 

MOVE TO X6 


Sa6 




JP 

LOOP 


MASKl 

data 

080000000001777700809 


data 

00000000000000007777* 


Data 

OOOOOOOOOOOOOOSOQOOOS 

shift 

Data 

19 



Data 

2 



USE 

/Cm/ 


JMS 

BSS 

300 



USE 

^CIDEXR/ 


M 

BSS 

2 


MU 

BSS 

1 


MD 

BSS 

1 


istag 

BSS 

21 



End 
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•DECK JmSPRT 

JftSPRT 

JMSPr>T ppj^y jpjjgjj ARRAX. aM8 


»*'w i^^hsprt^ 

common /UORIO/ LHO.UHE, LaDO;LBDE, LTO.lTe, LWO.LHEi LrO.irE 
. LOiLESTA. LDOMCei, UHU.LWt, LEO.UFE, 

* ''*’<NJ,M*X 0 L.MAXNM,MAXLE. 

nrMCMcm.. LEOiLEEi LRO.CRHbLRD 

dimension LIMITS(24J 

equivalence tLlMITSiLHO) 

COMMON /CIDEK / M.J.mU,MD,ISTAQ 
Common /cm / jms<300) 

COMMON /Erase / iout(8oo>. 

HEsTOR PAGE 
WRITE ( 6 :i 000 ) 


40 


50 


M 

IS 
I 

MA 
CALL 


8 1 

= 30 
s 1 

= M 

GETlx 


: 0 ) GO 
M 

istag 


TO 60 


60 


IOUT(i )»j 

IOUT( I*l)sMU 

lOUTI I+2)aM0 

*E(Istaq ;eq: 

10UT(IS*1) a 
JQUT ( IS*2) f 

« IS ♦ 2 

i ' 

T *,^♦1. 

f(I»LT;3o ,ANd; M,LE,NMj go to 50 

18 3 I'l 

WRITE 1,6.1002) MA,( I0UT(L).L'81.IB) 
iHM.LEtNM) Go TO 40 
lonn rni ^ <<^* 1004 ) (I 0 UT<l),iA 3 i,iS| 

JSSS r°^”AT< 8 HlJsMy-MQ) 

1002 ^ORMATdx. l5«3oi4, 

RETURlIi‘^“” R-ISTAG/(4X,20l5)) 

End 
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oooooo ooooo 


•DECK LBF 

function lbfodynahj 

• LBF-*» BOUiiDARV TABLE INDEX FROM BDY NAME •LBF# 

integer BLANKiBDYNAH 

BOUNDARY TaBLE 
INDEX- LB>lBBDiLBDE 
LBfyjEXT^ InCrBmEnT TO NEXT BqUNDARY 

LBZl « increment TO THE FIRST tOUNDARY POINT (»0 BEFORE COALLATIO 

chnaMes chanNel with whicH THfi boundary data is associated 
UP a T OR F FOR UPPER OR LOWBR BOUNDARY 

LEDEX s relative INDEX OF L'.E? POINT WHEN LOWER AND UPPER SURFACE 

Contours are coNNECfEB 

BDNaME,LBa;LBB«NAME and index LIMITS OF SPECIFIC BOUNDARY 
data when BOUNDARIES ARE COALLAtED 

Common ^chdata/ bdtiD ,LBNE xTeu » lbzi(1> * 

1 CHNAME(1).UP(1)7lEDEX(U . 

2 28T(l),RBT(i >; aN6BTi42) 

LOGICAL UP 

integer 8DT»CHNAmE,BDNAME 
dimension BDNAMEU) iLBAMi fLBB(X) 

EQUIVALENCE IBDN AME i ZBT ) » UlBAiRBT). (LBBiANGBT) 

common /IXORlG/ LHQ.LHE, lbdo»lbde» LTO.LTE, lwo,lhe; LF0,LFE» 

• LOiLESTA, L'DUMIB), 

• MOiNM. NJ.NFCOLS# MAXNJVmAxOLiMAXNMiMAXLE# 

• LEOiLEEi LRO.LREiLRD 
dimension . LIMITS<24J 
equivalence <LIMITS*LH0) 

COMMON /CBIT8 / BlTSiBLANK 
search for matching boundary NAME 

LB a LBDO 

60 lF(8DT(LB)lBi;8LANK ,0R, UB'.Gfi'.L'BDE) GO TO 80 
IF(BDt(LB) .EQiBDVNAM) GO TO 7fl 
LB e LB*LBNEXT(LB) 

GO TO 60 
70 LBF > L0 

return 

80 LBF 8 0 

return 
End 
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o n o o n 


SUBROUTINF 

•LFITI LINEAR FIT INTERPOLATION 

dimension x(iO).yao»-; xcao).YC(iO) 


PLFIIP 


C 

C 

C 

C 

C 


■ LIST or COORDINATES DESCRIBINO THE INPUT FUNCTION 
NpSs , NUMaER^OF_X.T/0,HTS 9, penroRMEO 

NXC s number OF XC"VAlUES 


c interpolated at XCdO.ICsl.NXC 


X| THE END VALUE OF Y IS 


NOTESr ^ 

IF Xc IS OUTSIDE OF THE RANGE OF 
FOR VC* 

X must be listed from smallest to largest, «i,»ikiinTV 

DOUBLE x!pOInTS ARE ALLOWED FOR A FUNCTION DISCONTINUIT , 


Common /cLfiTi/ lfout 
logical LFOUT 

N s NPTS 

I B 1 

BEGIN INTERPOLATION LOOP FOR XC< ICI i ICsi, NXC 

IC « 1 

60 XCIC s xcdO 

IF(NiGT’.I) 00 TO 100 
YC( IC)sY(l) 

GO TO 190 


100 Xq a X(1*1>"XCIC 

IFIXGI 114Vli4*l02 

102 xr s xcic#x(i) 

IFIXF) llOtUO.120 

F.LT.o; (F Is the fractional POSITION IN THE INTERVAL) 

110 I ' *= Ul 

IF(I) lOOVlli.lOO 

111 I . 1 

YC( IC)e Y(l) 

IF (LFOUT) YCdelsO. 

Go TO 190 


r .GE’.i; 

114 I 8 !♦! 

IFd-'N) lOOillS.iOO 
11& I s N-1 

YC(IC)P Y(NJ 
GO TO 190 


c interpolate 

120 YG(lC)B ( Y ( 1 1 »XG*Y( I *1) *XP ) /( XG*XF ) 

c index to next XC^lCl 
I 90 IG S IC*1 

IFdC.L^'.NXCJ So TO 60 


return 

End 
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•DECK L0C2 

Function lockU»Ib) 

CL0C2*.». CDC VERSION 
c 1ABS{ ADDRESSllB)«ADDRESSnA) ) 

L0C2 n lABS^ LOCF< lB)«LOCr( !A) ) 

Return 

End 
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o o o o ocjo ooooociooo o cioocion 


•DECK LsPFIt 

Subroutine LfipriTtx.YiNPTS, xciyCiNxciNd) 
iUSPFiT integrate or interpolate PLSPFiT* 

c Integrate or interpolate ustNS a parabola which passed through the 
and <I*1> points but misses the <I«D and i \* 2 ) POINTS IIF THET BO 
EXIST) SUCH That the square op the deviation is a minimum, note 
that I IS generally selected such that 

^ X( II iLBrXC.LT.Xn*!) 

THE Equation eqr t^e parabola I9 

y^y(i) t 3«(x«x(i)i 4 e*(x»x<in»«2 

Dimension xao>iVao)» xc(io);yc(io) 

note, the DtMENSlON PlQP DOES NOT NEED TO AGREE WITH THE CALLING 
INpUT- 

Y PTSi ON CURVE 

NPTS no', GF X 

XC list of X AT WHICH CALC TO BE DONE 

Yc(i) integration constant if NDp-1 

NXC NO. OF XC 

ND sO to get COORDi •! TO GET 1ST DERIVATIVE, 

s-1 FOR integration 

Lend s linear fIt in end interval, t or f 

OUTPUT 

Tc coordinate or derivative AT XC OR 

YC(IC)« INTEGRAL<Y»DXJ FROM XC(1) TO XC(IC) WHERE 1C«2,NXC 

notes*- 

®XP MAY BE IN either ASCENDING OR DESCENDING ORDER; 

For Integration pxcp must be in the samb order as pxp; for interp 
NO special order is required: 

common /ClSPF / I, lend 
logical lend 

LOqIcaL MIThIN 

data KNAME/6HlSPF1T/ 

N 8 NPtS-1 

iFIND.EO.lilh Ifl 
ISAVE 8 0 

SGN B SlGN(i;,X(N*l).X(l)I 

c begin INTERPOUATION loop FOR XCfICI ICBl.NXC 

IC « 1 

c locate appropriate interval 

100 I 8 maXO*'i.MINO< I ,N) ) 

WITHIN? .false; 

NCOUNTb N 

102 IFINCoUNT) Ii9'l03il03 

103 NCOUNTs NCOURT-1 

XI s X ( i ) 

XD s xcnc)»xi 

IF<n) 104;120,104 

104 iF(SGNftXD) 105,107,110 

c f.lt.o; <f Is the fractional position in the interval! 

105 IF( I ,EQ.1) go to 120 
IFIND.EQ. (-1) ) GO TO ll’ 
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u 


1!; 10J» 

F 0 

11)/ I*l> '.HE./P T'j 120 

IF ( I .f.E’.fl) QB T.o I Ob 
f-r) TO 116 

E. fiT.o: 

no lF(sr<s;*txr:l !♦!) ) ) I20ill2,’ll4 

F. EQ.lio, tHECK JsTpgpaTIo^ AND D0U5i.fi =D!S’' SEfC^E I**C9EH6‘. 

IF ( ( ND ,Eq* (-1 n .n^'. ?A»4D. X n*l > , 63. X ( 1*2 n 5 j3 ■'0 120 

f.gt'. I'.o 

IF ( f ,EQ;N) QO TO 120 
!F(Nn.EO. (ilJ ) 00 TO 122 

116 1 a 1*1 

GO TO 102 

119 Call errqrkiksamE i 

preliminary calculations for interpolation or integration 

120 WITWIM«;tru67 

122 iFd-lSAVE) 124,129,124 
124 IsaVE * I 

TI = Yd) 

« X(Ul>-Xl 
Y3 s Yd*n»vi 

C S o'. 

TOP S o; 

80T C o; 

IF(LEND .AND? d.E3.l .OR. I.EO’.NM GO TO 128 
iFd .LEd) 38 TO 127 
Ifl ' X( 

^13 * X( I-l)*Xd*l) 

^OP s X1*(¥3«X1-<Y( Ul).v! )»X3)*Xl3 

BOT s Xi*Xl«Xi3»Xl3*X3 

127 1F(I,GE;n JOft; (XD.E3.0. .AND.BOT'.NE.O, n GO TO 128 

X4 * X( 1*8 >»Xl 

X43 a Xd*l)-Xd*l) 

T4 * Y(1*8 )-Yl 

TOP a TOP 4 X4«( Y3*X4 »y4«x31*x43 

80T k GOT t X4«X4*X43«X43#XS 

128 if(bot;ne; 0 ; ) C « »T0P/B0T 

8 a 0 ! 

IF(NiGT'. 0 ’.AMOi X3.NE.0d B « ( V( 1*1 > "Y I ) /X3 • C*X3 

129 IFJND) l3o;iA0il4l 

c NDs.i, integrate 

130 lr( '.MOT’.WltRlNl XD«X3 

Si s (Yl ; { 3 X 2 , ♦ C/3,*xD)#xD»«XD 
IE (WITHIn) go to 135 

C (*I» IS BEING incremented TO FIND APPROPRIATE INTERVAL, hENcE; 

c cumulate the Integral of the ith interval, 

sa a 9 a * SI 
Go TO 116 

C appropriate interval found. *(|>'^XCdC)-Xd#l) 

135 lFdC.EQ.il SA'YCdCl-Sl 
IF(IC. NE.il VC(lC)aSA*Sl 
GO TO 150 
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c NDaO. INTERPOLATG fOR COORDINATES 

140 YC<IC)« Yl ♦ <B * C*XD)«XO 
GO TO 150 

C nd-1. first figRlVATlVE 

141 YC( lO* B ♦ l>0*XD 
GO TO i5q 

150 IC » 1C*1 

IF(NXC-IC) 900.l60il60 

160 if(nd.ne; ( wU’.AND.xcnc) ,6o;xcnc«i)> j*i*i 
TO 100 

900 return 
End 
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•deck 

•lSUM^- CUMOlATIVE TAPgZOlDAL 

Dimension x(«)iy’»9>*s<9> 


integration 


DO 90 I«2#N 

90 s( n * n*T< I 

RETURN 


1) Utx< U-XM-i) > 


•SU-1) 


End 


•tSUH* 
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•DECK MBEGIn 

FUNCTION hB6IIN(J2) 

•MBEGIN riNB FIRST FIELD POINT 

C FOR A given streamline 


•MBEQINR 


input 

J2 


■ streamline index 


output- 

MBEGlNa field INDEX OF FIRST POINT ON ThB SL 


« 

« 

« 


COMMON /IXORlG/ LHOiLHEi LBD0;LBDE, LTO.LTE. LWOiLWE* LFOiLFE 

LOiLESTA, LDUMISI* 

MQ|NM» NJ.NFCOLS* MAXNJ.MAXOL»HAXNMiMAXLE* 
LEOiLEEi lro»lrb.lrd 
DIMENSION LIMITS(24) 

EQUIVALENCE (LIMITS'LHO) 


COMMON /CIDEX / M , J , MU i MD , I STKG 
Data kname/ahmbbgin/ 


c search for first point on streamline j 

101 M a 1 

lot) call GETlX 

IF IJ.EQ.j2 TaND. MU.EQ.O) 60 TO U5 
110 if(MiEqInm) ball errorkiknamej 

112 M 9 M*1 

go to 105 


115 mbEGInp M 
return 
End 


40 



Cl o o o o o 


• DEC>< MNMx 

SUBROUTINE HTNMAXIA. II, I2.AMIK|.1MINiAMAK;IHAX) 
HINIMUS-MAXIHUM SEARCH ROUTINE 

THIS procedure determines the MINIMUM AND MAXIMUM 

floatirq point values and their respective 
positions in a SPECIFIEB AREA OF AN ARRAY', 

dimension AU) 
amincai II) 

iMlNitll 

AMaXba(Ii) 

iMA^cil 
DO 5 I=Ii;i2 

IF( A( I ) ;qE. ANIN) GO TO 10 

Amin=A(I) 

IMIN«?I 
GO TO 5 

10 if(a( I );le*.aHaX) gO to g 
AMAX = A( I > 

IMAX=I 

5 Continue 
Return 
End 
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subroutine M6VE|NR,Xl,Yl,Ni;NDi;x2,Y2iN2,ND2»X3,V3,N3,ND3> 
CMOVE 9.— rORTRAi^ SIMULATION OF MOVE (CDC) 

dimension XKl) lYKl) iX2(l);Y2<i)iX3(l) I'YSli) 

DO 100 L«i,NR 
Go TO (9»i0.15) f L 

5 N s IaBS^nI) 

NO s NOl 

J Nd?>^1 

NS a N1 
GO TO 40 

ID N a UBSfN2) 

NO a ND2 

*F( N2,Ut*.0 J Nd*,1 

NS ■ N2 

GO TO 40 

19 N. a UBStfN3) 

NO s ND3 

ir< N3 ,Lt'. 0 i NDt*»l 

NS « N3 

4 0 K a 1 

1F(NS)401 .‘l00*4l 

401 K - N 

41 iF( (K.LEio) '.or; (k.gt.nj ;or; ns.eq.o ) go to 100 

GO TO (AS.'SOrSS) , L 
Y1(K) b XKKJ 
GO TO 80 

50 Y2(K> = X2(K* 

GO TO 80 

59 Y3(K) a X3<KJ 

60 K a k*NQ 

GO TO 41 

100 continue 
RETURN 
End 
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„ ^IH*.**'***' 


r OKA - 

rn TO 

00 ^ , Nt 

^''^GOA'>H^ 

U" « ro 
lA^ fl'Vo i*0 

SO 10 \ ^ kL 
SO 10 v»«,^ 
A CONll**^^ 

Uo co^i««^ 

00“ DCIUOt* 


END 
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• DEC 


:k empyc 

subroutine fflPYC*NR,C.Xl.,Yi;Nl,x2,Y2,N2;x3,Y3,N3> 

XI U > • Vl( 1 ) . X2 ( t ) ,>2 ( i ) ,X3 ( X ) , V3 ( 1 ) 
CFMpyc - 8 — fortran simulation or FMPVC (CDC) 

nn!^nni9 4*kiA 


Do 300 L* 1 ,NN 
GO TO (205V210,215) 
205 NS « N1 
GO TO 240 


210 

215 

240 

245 

250 

255 


NS = N2 

GO TO 240 
NS s N3 

Do 2B0 KsiiNS 
GO TO (245. 250. 255) 

TKK) s c«xi(k) 

Go TO 280 
T2(K> 3 C«X2(X) 

GO TO 280 
Y3(K) s C*X3Ik) 


L 


260 Continue 

300 CONTINUE 


return 

End 
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•DECK 01R6M 

Subroutine oIremuiTi xjPi qv) 

•OIREMb quadratic interpolatior root evaluation PQJREM* 

c Tor PunCtIons with maximums 

dimension oy(6) 

data -KNAMH/6H0IRBM / 

JNPUT- 

X ■ ABSCISSA 

Y B ORDIRATE (OR ERROR) 

XJP s X-JURP TO 8E TAKEN BEPORE ROOT/HAX IS SPANNEDi THE SIGN I 
A POSITIVE Error 

QV • STORAGE roR EIGHT ELEREMT QIRE VECTOR 
QV(l) B CtR bO', iriRST ENTRY QNLYl 

ytol b Tolerance on the error 

Yo B ORDIRATE to be OBIAINED (OPTIONAL) 

dydx b estimate or slope for 2nd Guess (optional) 

CTRMAXb MaxIRuM no, of iterations («25 if not specified) 

output- 

X S NEXT X estimate 

QV(i) a o; if ytol has been satisfied 

0V(5) a 0. if max PT HAS BEEN FOUND WITHIN YTOL* 

ano abs(e>,gt;ytol: 

notEs^ 

c a THIR# coefficient in the equation- YaA*B*X#C*X**2 
a 012 In ojre notation 

Nl a exit value OF 0V(5), Nfa4 IF X IS THE PRECICTED MAX PT. 

Nia*S(.»5) IF X IS JUST TO ThE LbFT(RIQHT) OF THE PREVlOUSL 
PREDICTED max PT, Nl=6 IF X IS THE SECOND PT CLOSE To THE 
otherwise N1>N, 

M a entry VALUE OF QV(9) 

s®M a Sign of m if abs<m)*5 

SDYDX a SIGN OF THE SLOPE OF THE CURVE 

Xj a JUMP TO BE TAKEN FROM LAST X 
XJA a ABSOliUTE VALUE OF MAXIMUM JUMP ■ ABS(XJP) 

XM a distance FROM CENTRAL PT TO MAX/MlN OF PARABOLA. axMAX«XX{ 
OR B distance PROM CENTRAL PT To THE ROOT, aXR 00 T.XX( 2 ) 

XI ■ input <0R last) X VALUE 

COMMON /COIR6M/ YTOLi YO.DYDX.CT rMAX 

COMMON /ERASB / BOT , C . OXOTVE. I . f I , I N . ISPAN.H, N, RADICL . SDYDX , SGNf 
1 T0P.Xl,Xl3,xiSP;XJ|XJA,XM. DX ( 3 ) , DY ( 3 ) .QVl ( 10) 

dimension XX(4).YY(4) 

BQUIVAI-ENCS (CTR.OVKin, (Ni.aiND.OVUS) ) . 

1 (XXtQVi(2)), (YYJOVKPI) 

C initializing and preliminary CHECKING 
IF(CTRMAx;EO70’. ) CTRMAXb25; 

Do 30 Ifl.8 
30 OVKl )» OV(t) 

Nl ■ IFIxIQVIIS)) 

E a Y^YO 

M a Nl 

If(ctr;bq!o‘, J MiO 

SGM ■ l‘, 

IF(M,GE;0) 00 to 36 
M s 5 

sgm b ;i‘, 

36 N a HINOtM.3) 
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c 

c 


41 

42 

43 


44 


46 

45 


sdydx • siQig|i:,;xjp> 

(Alternate cauC to circumvent Compiler error) 

IF<XJP) 4i;4ti42 
Sdydx > i; 

Go TO 43 
SDYDX * «i; 

XJA 8 ABS(XJP) 

Xl B X 

IF(M^5) 44.45,46 

IF< ABS<E) ICeTYTOL) go to 800 

IP(M,E0;4 .and; ABS<E-YY{2)),LE;YT0L) Go to 700 

IF(CTR,GE.CTRmAx) call ERRORKeKNAMEJ 

GO TO 50 

^ » 3 

Xl3P B XX(3J-XXU) 


c determine index for inserting current X,e into XXiYY table which is 
c ordered according to X, 

50 in B 1 

IF (N.EQrO ) GO TO 90 

60 if(XX(in);qT;xi) go tq 70 
IN P JN*I 

IF( iNiLE.NJ GO TO 60 

GO TO 90 

c relocate In preparation for inserting x;e 

7011 B N*1 

60 XX(II)a xx(tl.-l) 

YY(II)s YY(1I*1) 

II B I I «1 

if<ii;ne;inJ go to bo 

C I^SgRT New POfNT 
90 N a N*1 

XX(IN)a XI 
YY( IN)S E 


c LOCATE interval WHICH SPANS ROOT 
ISPAN B 0 

IF(N.EQ'.I) go to 200 
DO 110 Ts2,N 

IF<SDYDX*YY*I I ,GT,0, ,ANB; SDYbX*YY<Ial),LT.O, ) ISPAN"! 
CONTINUE 


c Reduce xx;yy table to three points 

IFIN.LE;?) , 80 to 200 

IF( ISPAN.EO'0) go to 140 
C (ROOT WAS been SPaNNeD) 

122 IF( ISPAN;eQ;RI GO TO 150 
IF( ISPAN. EQ*8) go to 1'5 
lF(ABS(YY{l)r.GT,ABS(YYU))i GO TO i5Q 
GO TO 175 

C (ROOT has nOT been SPANNED) 

190 IF(IN.LE;2 ) go to 1,75 

c delete First point 

150 DO l60 IbI.'R 

XX(I) 8 XX(|*1) 

160 YY(l) 8 YY(Ul> 

ISPaN 8 iSPaSwI 
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c delete Fourth point 

N s Nil 

c simple x-jump prediction 

2U0 Nl - ^ 

iFdSpAN.oT’.O -OR. DTDX.NE'.O'J 60 TO 205 
C Xj 1 SDYDX«Sl®N(XJA,-E) 

C (alternate calc to CIRCUMVENT COMPILER ERR0R> 

Xj s.XJP 
iF(EiLT'O-) XJ**XJ 
Go TO 900 

C CURVE FIT predictions 

205 lF<N-2) 2l0ia20,300 

c one point prediction based on Input value of dxdt 

210 XJ s ;e/DVDX 
GO TO 900 

C TWO point straight line prediction 

220 BOT « YY(2)-YYU) 

IF{BOt;EQ.o;1 go to 230 

DXDY s (XX(2)-XX(l) )/B0T 
IF(DXDY«»SDYDX,Gt;o, ) GO to 240 
C (CURVE SLOPE IS WRONG MOVE TOWARD MAXIMUM POJNT) 

230 Xj e i3;«80YDX«XjA 
Go TO 900 

c (CURVE Slope is correct! 

240 Xj 8 iE»DXDY 

GO TO 900 

c parabolic curve fit prediction 

300 Dx(D * XX(lUXX(2) 

DX(3) E XX(3)-XXI2) 

Dy(1> s YY(1)’-YY<2) 

DY(3) w YY(SI-YYI2) 

0OT s DXtl)*DY(3> - DX(3>»DY<i> 
lF(ABS(BOT)iliT;t.E8l2) GO TO «09 
Top 8 DX(l)8Dx(i)»DY<3> - DX{3>*0X(3)*DY(1) 

XM B ,5*T0P/b 0T 
Xl3 * XX<3J*XXll) 

1F(ABS(XM)'.QT;abS(1;e3oX13)) 80 TO 600 
C a BoT/<Oxa)»DX(3)»X13) 

RaD^CLe xMeXH . YY(2)/C 
IF<RADICL'.LE7o; ) GO TO 360 
SGN « SIGNU; ,‘SDYDX*C) 

XM * XM ♦ SGN»SQRT(RADICl> 

Go TO 890 

(IMAGINARY ROOT; HENCE WE ARE LOOKING FOR THE MAXIMUM POINT, 
PREDICT MAX PT IF Ms3, SELECT PTS ON LEFT/RIGHT SIDE OF PREVIOUSLY 
predicted PT IF Ms4/5) 

360 IF(M.-4) 363,864,365 

363 IF(ABS(Xm)'.LT;XJA) N1*4 
Go TO 89g 

364 XJ s .X13/8, 

Nl e 5 

IF( IN.GT;?) 80 TO 900 
Xj s -XJ 

Ni * «5 

GO tO 900 

365 Xj E SQM«V13P/4, 
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N1 =6 
GO TO 900 


retreat to LINEAR INTERPOLATION 
600 IF< ISPANIgT;#) go TO 122 
GO TO 140 


maximum found 
700 Qii^jD 8 O’ 

GO TO 930 

solution found 

800 CTR o o; 

Go TO 930 


finis 

890 Xi 


900 

910 


930 

950 

999 


* XX<2)*XM 
Go to 910 

XI 8 xi*xa 

continue 

X S AMAXl(XXU)-XJAiAMlNieXl,XX(N)*XjAn 

CTR s CTR*1‘. 

OO 950 I*ii8 

°V(I) e QVi(f) 

QV(5> 

RETURN 
End 


• FlOAT(N1> 
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•DECK SS5PT 

Subroutine ssspt 

•SS5PT SUPBRSONIC 5-PT FORMULA PSS5PT* 

INPUT- 

X(l-4)a point spacing FROM POINT ZERO 
AaFACTb 1 FOR CuBiCi =0 FOR SlMB A4 AS A PARABOLA 

output- 

AOi A1,A2 . a3, A4S INFLUENCE COEFFICIENTS FOR D2Y/DX2 AT X<4> 

COMMON /CSS / SSFMLiSSeF,SS6ANG,SSDF,SSFEND,SSFND1 
1 .’SSDLE.AAFACT.BRLX.CURRLX.TSIC 

INTEGER SSFML 

LOGICAL SSEF; SSDF, SSDLE 

COMMON /CSS5PT/ X(4)iY(4>* X2l . X3l » X32 » X41 , X42 » X43 • Ao i Al i A2;A3f A4 

J43 ■ X(4)*X(3) 

C42 « X(4),X(2) 

^41 » X( 4),X( jl) 

^32 s X(3)-X(2) 

^31 8 X(3)*X(ll 

^21 8 X(21.X(i) 

A4 8 2;/<X42*X43)»(l.*A4FACT*(X42*X43)/X4l) 

Al 8 (»A4lx(4I«X42*X43 * 2?« <X( 4 >*X42*X43 ) >/ 

^ (X(1)«X21«X31) 

A2 8 (*A4#X<4)»X41»X43 - 27*1 X( 4 ) ♦X41^X43 ) > / 

1 (X(2)*X21«X32) 

A3 s <:A4#X(4)«X41*X42 ♦ 27«( X< 4 ) ♦X4l*X42 ) ) / 

1 (X(3}»X3t«X32) 

AO 8 ^(Alf A2«A3*A4) 

return 
End 
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•DECK TABPRT 

subroutine T4BPRT(MAMei A#N*.NCQLX| 

CTABRRT--. CDC VERSION 

dimension AllO) 

INPUT" 

Name e arra¥ name to be prInteo 
A B array to be printed 

NA b number of elements 

NCOLl a number OF COLSi TO BE USED IN PRINT FORMAT 
%tnt (MAXIMUM = NA ) 

IlTAB s LOC; OF FIRST ELEMENT IN A TO BE PRINTED 

Common /cbits / ibitSiBlank 
COMMON /CTABPR/ IHAB 

equivalence tLSPACE.ASPACBI . (IBiBj 

Dimension fmT(12) 
peaU I12 

Integer noi-iiiHTEsT 
Data ibci/ooioooooooooo/ 

Data (FMT{ j)*Jal»i2)/10H(lx;i5 ,10H ,10H I 

«10H *10H *10H »10H » 

«loH .IflH ViflW 

•lOH 1/ 

F8. F6i E5. BCD, 0?^* , ^ 

•6HiF 12;1. 6M»'F12‘,3, 6H,ri2',6» 6H#E12,4, 6H,6X,A6 i 6H*8X,04, 4HiU2 
*/ 

Data HMASK/OB0000000000077777777/ I HTEsT/000000000000055555555/,' 
• INMASK/037777777000060600080/ 

data nINMSK/077770000000000000000/ 

NcOl s MiN0|NcOL1,10) 

NB * NA 

C WRITE HEadIN® 

Write (6;iooo> name 

45 ll a IlTAB 

I s II 

l2 « 0 


C 

C 


WRITE line space 
47 write <6;iOOI) 
LOCATION OF NEXT 
ASPACEb A<I*i) 

^F( LsPACE'.UE’.I 


line space IS GIVEN BY A(I*1) 

.or; LSPACEiGE'.tBCl > LSPACBalsd 


LSPACE4 LSPA8E*I»1 
Go TO 110 


c begin l°°p to define li^e 

48 II a 1 

c 

50 8 said 


c SPECIAL Numbers 

NN a NINMSK’.AND.B 
IF( Nn;EQ.NINmSi< ) GO TO 82 

c TEST For HOLLBRITH MAx.) 

hOl,l 3 H^aSk’.aNd.B 
IF( HOLL.EO'.yTEST ) GO TO 80 

c TEsT For InTESER <BITS 36-58 bB POR max 635 INTEGER 
C FlOaTiNq POjNT NuMgcRS NORMALIZED 
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IM iB'.EQ'.iBtT? ) aO TO 85 
1N7GR » IMMA 8 K. ANDi IB 
IF( InTQR.EQ.O^ J QO to 82 

c ^eal ^umbe^ •* normalized 

8 a ABS<B) 

FM,T< I I*l)« E5 ^ - 

IF( B.LT-.i:e*3 -.or, a.GE.l.EB 
65 FMT( I I*l>a P8 

IF< B'.GE.i’.El ) FMT{ll*l)fr3 
IF( B.GE.i'.ES ) FMT(ll*l>»Fl 
GO TO 90 


GO TO 90 


C BCD 

BO FmTH I*l)3 BCD 
GO TO 90 


c integer 

B2 FmT( 1 112 
GO TO 90 


0 


OCTAL 

85 FMTM1*D* OCT 
90 I I 8 II+l 


100 


1 * 1*1 

iF( I .gt.lspRce j go 

IF( ir,LE*,NC 8 L ‘.and, 


TO 100 . 

I.LE.NB J GO TO 50 


12 8 I-l 

WRITE ( 6 ;fMT) 


111 ( A(K) ,K8li;i2) 


1 1 a I 

110 IF( I.GE'.NB i GO TO 990 
in i.gt'.lspAce ) GO to at 
GO TO 48 


990 IlTAB 8 1 
1000 F0RMAT(/2X. A 6 J 
1002 FQRMATdH ) 

Return 


End 
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•DECK TAN 

fUNCTlON TAN^X) 

*TAN--« »TAN* 

Tan » siN(M)/cos(x) 

RETURN 

End 
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•DECK LBOYBl 

Function lbdybl<bname, lower) 

CUBDYBL locate INDEX IN BL INPUT TABLE 

logical lower 

Integer bname 

boundary table 

Index. LBsLBDOiLBDE 
lbnexts increment to mext Boundary 

LBZl X increment to THE FIRST BOUNDARY POINT <»0 BEFORE COAlLATIO 
CHNaMEx channel with wHIcH t^^b boundary data Is associated 

Up S T OR F for upper OR LOWER BOUNDARY 

LEDEX X RELATIVE INDEX OF lIH; POINT WHBN LOWER AND UPPER SURFACE 
CONTBURS ARE CONNECTED 

8dnahe,lba,‘lbb«name and index limits of specific boundary 

data when BOUNDARIES ARE COALLATED 
common /CHOATa^ BDT(l),L8NEXTtli,LBZl(l), 

1 ChNAME(J.) »UP(1) .LEDEXd) » 

2 Z0T(l),RBT(l)rANGBTt42) 

LOGICAL UP 

integer BDT«CHnAm£i8DNAME 
dimension BONaME(X) ,LBA tl)»LBB(l> 
equivalence <0ONAMEiZBT)» (LBAiRBT), (LBBiANGBT) 

Common /bldtAi/ bnamsv 
integer bnamsv 

COMMON '^BCOLUT'' ZBCOL 
COMMON /CbITS / I3ITS.IBLANK 

Equivalence JbIts.ibits) 

c lbdyblxo if no boundary layer 
c lbdyblxindex of boundary in bl Input table 

Common /blbdw / blb(60) 
dimension IBLBUO) 
equivalence (IBLBiBLB) 

ZBCOL X BITS 
BNAMSvx bname 
LBDyBl X 0 

1 Lb X LBFIBNAMB) 

NCOLLBs L8Zl<’LBi/3 
assign 2q to LGO 

assign 40 to JGO 
assign 140 TO KGO 
iBDC 8 BoTlliB) 

1F( NCOLLB ) 5»5*2 

c Sequence for collated boundaries 

2 assign 10 to lgo 
assign 3 TO KGO 
ASSIGN 3 TO QGO 
LBC X LB«S 
NCOLBix NCOLWB 

if(Ledex(lb):eo;o) go to 222 
IF I ,NOT;lOWER) Go to 223 
LBC X lb 
NCOLBIs NCOLliB"! 

GO TO 222 

223 assign 20 TO LGO 
assign 40 TO JGO 
ASSIGN 140 TO KQO 
222 NBC X 0 
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i IF( NBC’.GB'.NeOLBl > GO TO <0 
NBC e N8C*1 

L6C « LBC*3 

^ IBDC • BONAHEICBC) 

5 IBl 3 -2 

6 IBl 3 IbL*S 

IF( 1BLB(IBL1 ;EQ,;BDC > GO TO LQO,i20ilO> ^ , 

IF( 1BL'.GG.98 ;qR. iBLBdBLi.BQ.IBlTS) GO TO KGO»(1^0|3) 
Go TO 6 

10 LbT s Lb*LBZ1{*-B)+1-BA<LBC) 

IF(LOWER) go to 12 

LBT 3 LB*L8Z1(LB)*LBB(LBC) 

12 ZBCOL 3 ZBt(LBT) 

20 If( iBLBtiBLJU'.EQ.O ) GO TO ilG0.(4Q,3) 

LBDYBL3 IBL 
40 return 

140 Call errork(6hlbdybl) 

Go TC 40 
end 
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•deck stand 

subroutine STANOtMiLRiUPPERi 

•STAND* StAtlON INDEX PROM F1 Ei;D POINT »STANO* 

logical upper 

INPUT"- 

M « F!EC0 pt index 

LR « 0 rop FIRST ENTRY OTHERWISE LR.NEiO 
output- 

LR s STATtON Ta3LE INDEX 

UPPER a T IP M IS AN UPPER BOUNDARY POINT* sp OTHERWISE 


C 


station Table 

INDEX, LaLOiLESTA 

SCHOKEa STATION ChOKE INDICATOR ( ADjWP i BRHS* WR 1 OUT ) 

hcl a SHARP Corner indicator (Budtbs) 

MCL » field index of control streamline (PTMOVEiPLOBAL) 

common /CHDATA/ X1<1>»LNEXT(1)iMLB<1)iMUB<1I»PRIM<1)i 

1 TyPELBlD.NAMgLBdli ILB(1) |FLBI1 )iS1L8(1)i 

I TYPEUBll),NAMfiU8<l)| IUB<1> |PUB<l) iSlUB(i># 

« VMBll) ,DWDV{1 > ,x2cL(1>iSLSWI(1) ,MCL<1) • 

& ANGTE(l)iPTtEtl)*PSTE(l)*FGRTE<l)iRGTE<l)i 

« AN6EXP<l),BSQgXP<479> 

dimension CRVLE(I) |ANGLE(t> 

EQUIVALENCE (SCHOKEiDflDV) »(CRVLE»ANQTE) .( ANGLE |PTTE) 

integer PrIMiTYPELB.'TYPBUBiSCHOKEID 


« 

» 

ft 


COMMON /IXORIQ/ LHO.LHE, LBD0»LBDE| LT0,LTE* LWO,LWEi LF0,LFE» 

LO.LESTA, lDUM(8), 

MOiNMi NJ»NFC0LS» MAXNJ.MAXOL iMAXNMiMAXLEi 
LEO, LEE, LRO,i:RB,LRD 
DIMENSION LIM1TS(24) 

EQUIVALENCE <LIMITS#LH0> 

Data kname/6hstano / 


L 8 LR 

ira.EQ’.o) L a Lo 
Upper = .talSe'. 

LSAV a L 
LSTOP a 999999 

120 1F(L,GE*.LST0P) call ERRORKIKNAMB) 
IF(MUbIL)',EO'.’m) 60 TO 150 
IF(M,GE,ML8(L) .and; M.LE.MUBtD) GO TO 160 
L a L+LNEXTIL) 

IF(L.LT;LESTR) go to 120 
L s LO 

LSTOP a lSAV 
GO TO 120 


l&O upper a .true; 
160 lR a L 

Return 

End 
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•DECK STAXl 

SUbRCuTINe STAXKXir INd,X2B.'X2a;LXB,1-XA) 

• STaXi. StATlON INDEX FROM Xl AND X2-COORDINATES «iSTAXi(i 


C 

C 

C 

C 


input,. 

XlFINOa XliCOORDiNATE 
X28 s X2-C00R01NATE 
X 2 A a X 2 ;C 00 RdINATE 


OF UPPER boundary (I.E, STATION BELOW THE BO 
OF LOWE* boundary (I.E, STATION ABOVE THE BO 


C 

C 

C 


output- 
LXB a 
LXA a 


INDEX OF station WHICH 
INDEX OF station WHICH 


CONTAINS C00RDINATES-XiFIND,X2B 
CONTAINS C00RDINATES»XIFIND,X2A 


C 

C 

C 

C 

C 


C 


station Table 

INDEX- LaLO.llESTA 

SCHOKEa STATION CHOKE INDICATOR ( AP JWF i BRHSt WR 1 OUT > 

mcl a Sharp cqrnEr indicator tbldtbs) 

MCL 8 FiELfi INDEX OF CONTROL STREAMLINE ( PTMOVE i FLOBAL ) 

common /ChDATA/ Xl(l)iLNEXTa)tMLB<l)iMUB(l).PRIM(l)» 

1 TyPELB(1),NaM6LB(Hi ILB(l) ,FLB(1).S1 LB(A)i 

1 TYPEUa(l) ,NAM6U8<1) ,IUBtl) ,FUB( 1) ,SXUB(i) , 

^ VHB(l) ,DW0Vai ,x2CLU>iSLSWI(l),MCLa> • 

« AnQTE(I) iPTtEfD.PSTEdJ .FGRTE(l>iRGTE(i)i 

« ANGEXP(t)»BSOEXR(475) 

dimension CRVLE(l) I ANGLE(i) 

EQUIVALENCE < SCHOKE , DWDV )*( CRVLE , ANGTE ),( ANGLE , PTTE ) 

integer PRlMiTYPELB.TtPBUBiSCHOKEd) 


COMMON /IXORIG/ 


a 


DIMENSION 
equivalence 
Common /slTab / 
Integer slchn 
Common /cidei / 

Data kname/^mstaxi / 


lho.lhe, lboo^lbde, ltovlte; 

LO.LESTA, LDUMiel, 

HOiNM# NJ.NFCOLS. MAXNJ.MAXOL 
LEOiLEEi LROiCRE.LRD 
LIMITS(24» 

(LImITSiLHOJ 

W(128)iX2d28»,sLCHNd28) 

M, J,MU,MD» ISTAG 


LWO,LWE, LFO.lFE, 
«MAXNM»MAXlEi 


NFOUND" 0 

IF Ix2b;GE 10J ) NFOUNDil 
IF(X2 a.GE,0; J NFOUND8NFOUND*! 
L , * LO 

110 IF(X1(L).NE‘.X1F1ND) go TO 120 
M a HUBOi) 

call GETIx 

IF(X2( J» .nE',X2B) go TO U5 
LXB a L 
NFOUND* NFOUND-1 
^0 TO 120 

115 M s ML'b(U) 

CALL GETIX 

IF(X2(J) ,NEiX2A) GO TO 120 
LXA a L 

NFOUNOa NFOUND-1 
120 L s L*LNEXT(L) 

IF(nFOUND’,EQ70) go to 130 
ifiliLT'.lestb) go to no 
call ERRORK(MNAME) 


130 return 
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end 
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•DECK STCN 

OVERLAY<STCii,0» 
program STCM 

COMMON /cTaPOS/ RESTRT , EMDBDT , STCF IL i K6SV 
logical RESTRTiENDBDT.STCFIL 

COMMON ^SELECT^ LENTRY 
1 GO TO (9.10J , LENTRY 
C READ INPUT 

5 CALL 0VERLAYnHSTCil|l|6HRECALLi 
Go TO 20 

c build tables 

10 IF(RESTRT) go TO 15 
LENTRYa 1 

call OVErlAY^SHSTCi lt2»6HRECAi,LJ 

call 0VBRLAYf3HSTCili3,6HRECALM 
LENTRy* 2 

12 CALL 0VERLAYf3HSTC,l,2,6HRECALLr 
Call 0VERLAY<3HSTC»l»4i6HRECALLi 
GO TO 20 

c restrt Case 

15> LENTRYa 2 

Call ovErlay(3Hstc#i#3»6Hr,ecall) 

LENTRy? 3 

call overlay (3HSTC»1# 2, 6HRECALL> 

20 return 

END 
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•DECK ERRORN 

Subroutine ehrori 

CEDUMPN STC EDUMP - INPUT CINK PEDUMPNP 

C COMALL 

c channel input baTa table 

C INDEX, LHbLHO.LHE 

dimension CHNAMa)»LHNBXt{l)iWTFLOW(l)» TT0a i*PT0<l)» 

1 TSO(l),P.SOa);MACHOM),AOaj,VARY<l)» 

2 RG<1)»GAM(1)i NR<l)(NC(i)iTAB(6)» 

^ - BB(75) 

LOGICAL vary 

integer CHNAM 
DIMENSION V0(1) 

REAL MACHO 

equivalence (VOiMACHO) 

sounoarv table 

INDEX. LBsLBfiOiLBnE 

lbnexts Increment to next boundary 

LBZl S increment TO THE FIRST BOUNDARY POINT (sQ BEFORE CqAllATIO 
CMNaMEs CHANMeL WITH WHlcH tHe BOUNDARY DATA IS ASSOCIATED 
up a T OR F FOR UPPER OR LOWER BOUNDARY 

LEDEX 9 relative INDEX OF L*,E; POINT WHBN LOWER AND UPPER SURFACE 

Contours are cqnnecteb 

BDNAME,LBAiL0B*NAmE and index limits of SPECIFIC BOUNDARY 
data when boundaries are coallated 
dimension BDT(1) iLBNEXTfli .LBZKl) , 

1 CHNAME<l)iUP<ir.‘LEDEXU)i 

2 ZBTa),RBT(i)#ANGBT(42) 

LOGICAL UP 

INTEGER BDT^CHNAMEiBDNAME 
dimension BDNAME(l)rLBAfl),LBB(l) 

EQUIVALENCE ( BDN AME i ZBT i » (L'BAiRBT), (LBB.ANGBT) 

table oF convSctbd properties 

INDEX. LTbLTO.LTB 

CH s chanNelname 

LTNEXTb index increment to the next , channel 
LPSI B relative location of psi list 

NPT a NO. 8F PSIi TTi PT AND RCU VALUES 
LTT a RELATIVE LOCATION OF TT LIST 

LPT a relative LOCATION OF PT LIST 

LRCU a relative LOCATION OF RCjJ LIST 

Dimension CHmiLTNExt<i)»NPTfi)iLPSi (Dilttidilptii?* 

1 LrCUIDi 

2 CRG(l) ,CPGJ(1),C2CP(1) ,QGAM(1) ,FGT{1),FGP(1); 

‘S FGRIl) IAREATB14S5) 

dimension XCH<1> 

EQUIVALENCE ICH.XCH) 

Table of wake displacement thickness 

INDEX. LWaLWO.'LWB 

Dimension X2w(i).'lwnextu).siw(47) 

DIMENSION DSTU) 

EQUIVALENCE (OSTiSlW) 

subtable arrangement ISb 

X2W,lWNEXT(A2*2N)i SlWIl ) ,S1W(2> ,SiWl N> , DST ( 1 ) . DST 1 2 ) • ; DST (N ) 
X2W a STREAMLINE COORDINATE 

SXW a DISTANCE ALONG STREAMLINE FROM T*.E, 

DST s Wake displacement thickness as a function of siw 

FLOW ADJUSTMEST TABLE 
INDEX. LFaLFO.'LPB 
NFCOLSa 8 

XlF a orthogonal COORDINATE 
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X2F s streamline coordinate Of SL EMJNATING FROM T.E, 

XIBF s Xl-COORDINATE OF CHOKfi STATION OF FLOW BELOW TiE. 

XlAF s Xl-COORDiNATE OF GHoKg STATION OF FLOW ABOVE T'.E, 

SlF s SlicaORDiNATE OF T'.E. <UPPER SURFACE), THIS ITEM 

IS USED when interpolating FOR WAKE DELTA-STAR, 
LFB.LFAslNOIGES OF STATIONS BSLOW AND ABOVE T,E'. 

NCHB-inCHAsNUMSER of channels BELOW AND ABOVE T.Ei 

LRF B Index of dummy ortchn list for the t.e, 

LRXF E index of LAST CHASNEL BELOW THE TiE* 

jqrders 0 IF total Flow at xif is given 
s 2 IF flow above T’.EJ IS GIVEN 
s 1 IF FLOW BELOW TiE*, IS GIVEN 
JORDERs IF FLOW at XIf IS CHOKED AND SlNQLE CHANNEL 

Dimension xiF(i)ix2F(i).xiBF(i)ixiAF(i)» 

1 SlF(l),NCHBa)*NCHA(l)i JORDERCDi VNR(12| 

equivalence ILFB.XIBF), (LFA;X1AF)| (LRF,NCHB>» (LRXF.NCHaT 

DIMENSION LFB(l)iLFA(i).LRFa»iLRXF(l) 

station Table 

INDEX- LslOiLESTA 

SCHOKEs STATION CHOKE INDICATOR ( ADJWP , BRHS .’WR I OUT ) 

ncl s sharr Corner indicator ^bldtbs) 

HCL = FIELD INDEX OF CONTROL STREAMLINE < PTMOVE » FLOBAU 

Common /chdata/ xi<i)ilnext(1I*mlbu)imuB(i)»prim(i)» 

1 TYPEL8<l),NAMBLB(i)i ILB(l) ,rLB{l)#SlLBU) I 

1 TYPEU8(l),NAMEUB<ll,lUB(l),FUB(l),SlUB(l), 

* Vm3(1).DWDV(1|*x2CL<1)iSLSW1(1),MCL(I>)* 

« AnGTE(I) iPTTEei)»PSTE(l) .FGRTE(I) »RGTE( 1 ) » 

« ANGEXP(l).BSQBXP(475> 

dimension CRVLEd) ,ANQLE<1) 

equivalence (schokeiDwdv)* (crvue»anqte). (Angle *ptte) 

integer PRlMiTYPELB.'TtPEUBiSCHOKEd) 

equivalence (CHNaM,BDT,CH,X2W.X1F,X1) 

EQUIVALENCE ( LHNEXT , LBNEXT .LTNEXT ,LWNEXT VX2F .LNEXT > 
equivalence (MTFL0W,LBZ1;nPT';s1W,X1BF.MLB> 

EQUIVALENCE { TTO . CHNAME . LPSI . XlAF * MUB ) • ( PTO • UP • LTT . SlF • PR IM ) 
equivalence (TS0,LEDEX,LPT;NcH8,TYPELB) 
equivalence <PS0,Z8T,LRCU,NCHA,NAMELB> 
equivalence {MACHO|RBT,CRQ,aORDER,ILB), { AO , ANGBT i CPGJ # V nR;FLB > 
equivalence (VARYiC2CPtSlLB> < RG » OGAM » TYPEuB ) 
equivalence (GaM,FGT,NAMEUB)'; (NR»FQP, IuB) , (NC,FGR,FUB) 
EQUIVALENCE < T AB ( I ) , AREATB • SlUB ) » ( BB , ANQTE ) 

EQUIVALENCE ( T AB( A > , X2CL > i( TAB< 5 ) , SLSW I) , ( T AB ( 6 > , MCL ) 

COMMON /ALLCOM/ MACHA , PSA , TSA;Pt A, TTA , AXI aVRGAiGAMA, 

1 MACHCiPSC.TSCiPtCiTTCi AX I C • RGC I'GAMC , 

2 DAXITiSCALEA.TTE.CHOTST 

real MACHA(l) .MACHC 

LOGICAL AXlAiAXlC 

LOGICAL CHOTST 

c streamline table 

COMMON /SlTAB / W(12B)iX2U28|,8LCHN(128) 

INTEGER SLCHN 

C FIELD TABLES 

C INDEX. MaMO.NM 

Common /cz f z<300) 

COMMON /CR / R(300) 

common /cS2 / S 2 OOO) 

COMMON /CSl / Sl<300) 

COMMON /CPHll f PH1K300) 

Common /cm / jmS(300> 


60 



onnnoo o n n o o o 


COMMON /CCUSV / CURV(300) 

COMMON /CB / 8(300) 

common /CIDEX / H, J,MU,MD;iSTjli6 

c ’^able of indb* limits 

COMMON /IXORIQ/ LHOiLHEi LBDO;lbDE» LTO.LTeV LW0,LWE» LFO.LFE* 

« LOiLESTA«LSO*CSE*UDOiLD|9iLDUH(4), 

« HOiNMi NJtNPCQLSi HAXNJi HAXOL i HAXNH i MAXLE i 

• LEOiLEEi LRQiCRBiLRD 

DIMENSION LIMITS(24) 

table of leading edge and trailing edge points 

INDEX. LE>LEQiLEE|10 

NlEiNtE»NO. BF LtEi AND T.E'. COINCIDENT PTSi RESPECTIVELY 
CHL.Chu=NAME of channel above and below PTi respectively 
BDLiBDU«B0UN6aRY names ASSOCIATED WITH THE POINTS 

NUSED 3 count of TIMES THAT POINT USED IN CONSTRUCTION OF /ORTCHN/ 
COMMON /LETEPT/ XE(l),Ye<i);A«|GE(l),NLE(l),NTE(l>, 

% CHL ( 1 ) I CHU ( 1 ) ;BDL ( U , BDu ( 1 } VNUSED (491 ) 

integer CHLiCHUiBDLVBDU 

table of channels EMBRACED BV EACH ORTHOGONAL 
Index- lr=lr0iLh6iLRD 

LRD s NUMBER OF CHANNELS PLUS ONEi LR INDEX INCREMENT 
LEDGE = INDEX OF THE ORTHOGONAL POINT IN THE LETEPT-TaBLE 
LRPREVs pointer OF LINE OF UPSTREAM CHANNELS IN 0RTCHN»TABLE ' 

chna s Channel names 

COMMON /ORTCHN/ LEDGE ( 1 )» LRPRBVfl )» CHNA( 479 ) 
integer CHNA 
DIMENSION JCHNAd) 

EQUIVALENCE IjCHNAiCHNA) 

EQUIVALENCE ( LHNEXT , LBNEXT*LtNEXT , LWNEXTV X2F . LNEXT ) 

EQUIVALENCE ( MTFlOW , LBZ lVNPT^SiW, XlBF , MLB ) 

EQUIVALENCE { TTO • CHNAMS ‘LPSI .XlAF »MUB) » ( PTO * UP » LTT • SlF # PR I M ) 
equivalence (TSO,LEOEX,LPT;NeHB|TYPELB) 

EQUIVALENCE (PSO, Z8TiLRCU.NCHA,NAMELB) 

EQUIVALENCE (MACHOi RBT,CRG;JQRDER» ILB) i ( AO, ANGBT.CPQJi VNR*FLB ) 
EQUIVALENCE ( VARY i C2Cp .SlLB) • <RGiQGAM»TYPEuB) 

equivalence (Ga^iFGT,NAMeUB)V <NR,FGP;IUB) , (NC.FGR.rUB) 

equivalence (TA8(1),AREATB;SIUB), (TaB(2>,VMB> , (TAB(3) .DWDVI 

COMMON /CeiTS / BITS, blank 
common /CDS2 / Ds2(3O0) 

COMMON /cLlNES/ L1NES»0MITFK»PT!TLE(6) ' 

LOgIcaU OMiTfK 

COMMON /CREDTN/ 2TR ANS , RTR AnS ^ROT ATE , ZP I VOT . RP I VOT , SC ALB , NB , TBB (9 ) 
equivalence (XTRANSiZTRANSJVIYTRANS.RTRANS), (XP 1V07*ZP1V0T)J 
1 lYPI VOTiRPiVOT) 

COMMON /CRHS t RHS(300> 

COMMON /CTABRR/ IlTAB 
COMMON /CVM / VM(300) 

COMMON /CSEGME/ I A < 10 ) , I B( 10 > ^ IMA (10 ) # IMB ( 10 ) , JTYPE ( 10 ) , 

1 N.NSEGi NIiNia 

Common /csmoob/ )<A(ioo),yA<iod);DEVi(iO{j) 

COMMON /CSMOflC/'DuMl{200)iANGei807iDUM2(400)»DEV(100>iCURVB(100) 

common /bLbDV / IbUB(60) 

Data txa/2hxa/,t2a/2hza/ 

IGGO r 1 
GO TO 1777 
Entry edump 
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IGGO s 2 
1777 Continue 

1100 FORmAT(///iXJ6HCHa'J'J6L input BAtA TABLE, /CHDATa/ •) 

WRITE (6,ll0fl) 

IlTAB s lMO 

NCX s NC 

lr(NCx,LT'.3> NCX»5 

Call TABPRffBLANK.CHSAM.LHE.'NCXj 

1120 Format<///1X94H80UNOART COORDINATES AND ANGLES IN RADIANS, /BDYT.AB 
m\ 

write (6,1120) 

IiTaB e lBDO 

call TABPRtl8LANK,9DT,LBDE,S) 

1110 FORMAT(///lX4lHTA0LE OF CONVECTED PROPERTIES, /CONVTB/ -) 

write <6,lll8j 

UTAB 8 ltd 

Call tabprt(Blank,cw,lte,7) 
if(lee;lt:lbo) qo to iao 

1130 F0RMATI///1X125H0RDERED .list OF UPSTREAM BOUNDARY PNTS, L.E, PNTS, 

* T,E, PNJs; J^ND downstream PNTS WITH REFERENCES TO CHANNELS AND BO 

“UNDARiES./lXiOH/LETEPT/ •//4 xShL'E6Xi 2HXB10x.'15hyE ANGE12x, 

•3hnlE9X,12HNTE CHL9X , 3wCHUVX, 3HBDL#X» 3HBDU10X, 5HNU9ED ) 

WRITE (6,113d) 

UTaB s leo 

Call TABPRt(8LANK,XE,LEE,10) 

140 iFiLREiLT'LRO) GO TO 150 

1140 FORMAT<///lXd8HTAB'JLATI0N OF CHANNELS EMBRACED BY THE ORTHOGONALS 

•Which pass through the above points, /ortchn/ 9//4x26hlr 
•Le LRiPRSV) 

WRITE <6,1140) 

UTAB = LRO 

CALL TABPRT(8LANK,LEDGEiLRE;LRP) 

1150 FoRMAT</// 1X17HSTREAMLINE TABLEi/l7X32Hj X2 ' SLCHN 

• W/( 118.F12’.6,6X, A6,F12;6, M 

150 write (6,1190) (J,X2(J),SLCHNfJ>,W(J),J«l,NJ) 

1190 FoRMAT(///1X37HHAKE DISPLACEMENT THICKNBSS, /WAKETB///UX19HX2W/S1 
•W OST) 

write (6;il90) 

UTAB 8 LWO 

Call tabprt(Blank,x2w,lwe,2) 

IIBO Format(/// 1X43HTA8LE OF FLOW ADJUSTMENT STATIONS, /CADJWF///15X5HX 
•lr9X,3HX2F8Xt4HXlBP8X,4HXlAP9X,3HSlF8X,|HNCHB8X.16HNCHA JORDE 

•R} 

WRITE (AillSfl) 

IITaB e LfO 

Call tabprT (Blank, xif,lfe*nfcols) 

1160 FoRMATt/Z/lXaSHSTATION TABLE* /STATAB/ -) 

WRITE (6,il60) 

IlTAB a LO 

Call TABPRt(8LANK,xi,LESTA,5) 

C PRINT overall data 

Call TABPRt<6HALLC0M,MACHA,20»ei 
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IF( iBLBdJ.^e.O ) CALL TaBPRT<5HBUBDY,ibi.B.60,3> 

IF( LDE;eo; 8 ) 00 TO 1321 
HTAB c LDO 

Call TABPRt(SHBLTA3,CHNAM,LDE;3) 

1321 Continue 

lr(LESTA,Le;0) qO to 900 
L » LO 

LMAX s LESTA 
180 OMITFKs .true*. 

LINES 3 64 
190 MA B MLB{L) 
s 

Call rHEAD(HB-MA*2) 

If (LINES;eQ7(Mb*HA*5) ) write (6*1200) 

WRITE (6;i20«) 

Do 200 MsMA.HB 

call GETIx 

WRITE (6,1201) J.M#MU.MD.ISTA6. S1(M > i S2 ( M > Vz ( M > i R ( M ) , PH 1 1 ( M ) . 
1 , CuRV^M) • VM(M) »B( mJ *RHS(M) *0S2(M) 

200 CONTINUE 

L a L*LNexT(L) 
if(l,le’,lmaxj go to 190 

1200 FORmAt(57x*i6hFISlO TABLE DUMP/i28H J M mU MD I Si 
^2 z R PHII CURV 

® DS2» 

‘tK.lS.3U,I2,2Fli.6;2ri8.6,ru,6.FlS.7,jril.3.2riO;5l 

1202 F0RmAT(1h ) 

iF( iGGo.Eo;a ) return 
LSTqP » 5 

GO TO (90o;i»77) , lSTOP 

’00 return 
end 
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•deck REDBUK 

BLOCK data RBDBLK 
•HEDBIK REDlNP BLOCK DATA 

COMMON /SPACER/ MAXLH. MAXLT .‘MAXl’F # MAXLW 
COMMON /CLW09V/ LWOSV 

COMMON /CTAPOS/ RESTRT , ENDBDT , 8TCF I L i'K 6SV 
LOGICAL RESTRTiENOBDTiSTCFlL 

Data MAXLM;MAXLT»MAXLF,MAXLW/«00,200,20fl,200/ 
End 


PREDBLKt 
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•DECK DBSRTi 

subroutine DBSRTK r,M,lNTRl*lNTR2|A.N,ll > 

•DBSRTI 

C DATE or THIS version . SEPTEMBER 28.1965 

c single precision double back substitution subroutine used WITh 
c URMDSl subroutine TO SOLVE SiMULtANEOUS EQUATIONS 

dimension nti.n.Adi.in.fNTRid) 
nn»n 

nmi«nn»i 

MMaM 

If (INTRKin 10,140,10 
10 IF(NN.LE.I) fio *0 40 
do 30 Kal.'NMl 
IlaINTRi(K*li 
If(Il) IS.'SOkIS 

1 & Do 20 J^IVmM 

XsF(K.J) 
f (K» J)»F( II. J) 

20 F(Il,J)«X 

30 continue 

40 DO 90 

Do 80 Lal.NN 
iFlFa.J)) SO.80.50 
50 F(L, J)*f (L. Ji/Aa.L) 

if(lieq»nn) So to ®o 

DO 70 laL/NMi 
If<All*i;Ln 60,70#60 
60 F(I*l,J)aF(l^i,j),An*l,L)*F(C.J) 

70 Continue 
80 CONTINUE 
90 continue 

1F(NN.LE,1) So TO 140 
100 DO 130 Jai,‘MM 

If(F(NMi*i;j), 110,130,110 
110 DO 120 laiVNfll 

120 F(I, J)»F(i;jJ-A(I,NMl^l)*F(NMl*l, J> 

130 Continue 

NMisNMi.i 

IF(NMI) 100,140,100 
140 return 

end 
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•DECK ISORT 

Subroutine isoRTix,Y,z,8,LB;Ksoi 

CISOHT*-. CDC VERStON •-MOVE COLUMN DATA TO ARRAYS 
COMMON /CBITS / BiTSiBLANK 

dimension X( 1 ). ViDiZd), B(U 

INPUT* 

5<*YiZ B New columns of data 

B • location of column data to be relocated 

LB a BbCOLUMN LENGTH 


‘ a 1 

OO TO ( io .30 ) . KGO 
10 1F( Bdl.EO'.DlTS ) GO TO 20 
X(K> a B(h 
Y(K) a 1 * 1 ) 

Z(K) ^ 8 ( 1 * 1 ) 

20 I s 1*3 • 

K a K*1 

1F( I.LT.lB I GO TO 10 

GO TO 50 


30 


40 


50 


IF(B( I ) iEQ'.BiTS) GO TO 40 
X(K) 80(1) 

Y(K) a B(I*1) 

1 a I *2 

•< a K*l 

IPd.LT'.LB) GO TO 30 

return 

End 
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•DECK LOOP 

Subroutine l.oop(A,b»CiN) 

•LOOP 

C THIS SUBROUTINE IS USED BY SUBROUTINE LRMDSl 
OIHENSION >(1)iBU) 

Do 10 1 p1.‘n ^ 

10 A( I )«A( h*B( I)*C 
return 
End 
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•DECK LRMDSl 

Subroutine cmwosK <^ iN. intri;ii4tr2,dbt i ifactr* i i i ) 

•URMDSl 

C date of T^+Is VERSION «- SEPTEMBER 20ii965 

C SINGLE PRECISION LEFT RIGHT MATRIX DECOMPOSITION SUBROUTINE 
C determinant 8 OBT»(2‘.0**IFACfRl 

c where (i5) lB8S than IABS(DET)J less than OR EQUAL ( 1*0 ) 
dimension AM),iNtR1(1) 

IDIM*III 

NN’N 

NBASEelNNilJtlDIM 

NtRbI 

if(Nn.le;i) bo to 30 

DO 25 K^2.’NN 

INTRKKIbQ 

DsOiO 

m-k 

l«kmi 

JST0P=KM1*NBASE 

KBASEalKMl-iUlDlM 

kkmisk+kbase 
KKsKMi*K0aSE 
IST0P=NN*KBA9E 
DO 6 I?Kk.*ISTOP 
BsA( I ) 

IKBASEiI-kBASE 

• modification to Select the pivot element as 1,0 if present,,, 

• DAV£ FERGUSON 10/18/66 

lF(B,NE‘.l'.) *0 TO 70 

D=i; 

LbIKBASE 
MxIkBASE 
Go TO 80 
70 continue 

IF(ABS(B):LE';aBS<D) ) go to 3 
DsB 

LsIKBASE 

3 IP(B)4i6;a 

A NsjkBaSE 

6 continue 
80 Continue 

KMsKfM 
KsTOPsM'KMI 
*F(D) 8. 7/8 

7 NTRAO 
INTR2sKM1 

, Go TO 60 

8 LKMlsLsKMl 
IF(LKmI) d0il7.1fl 

10 DO 11 JrKMIiUSTOP* IDIM 
UJ*J*lKMi 

XsA(J> 

A( J)sa(LJ) 

11 A(LJ)=X 
1NTR1(K)8L 
NTRsrNTR 
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17 KKaKK^IDlM 

DO 22 I"KkVJ 8TOP# lOIM 
^ ir(A(D) 19,12,19 
l’ A( nsA< I )/D 

IF(KM) 2o;20»22 
20 Qx«a( I ) 

CALL L00P(A(I*1).A(KKM1),Q,kST0P> 

22 Continue 
25 continue 
30 DxoiO 
KMlsNN 

KST0P=NN*nBA8E 
IF(A(kSTOP)> 40»7,40 
40 iFACefl 
D*1’.0 

iDIMlsIDlM*! 

DO 55 K»i;kST 0P, IDlMl 
1F( ABS(A(K) )?GE;1.0> GO TO 51 
DxD« 2.0 
IPACslFAC-l 
51 Dao»A(K) 

if(abs(D);i;o) 53,55,54 

53 DsO*2.Q 
lFACsiFAC -1 
GO TO 52 

54 D5D/2,0 
IFACsiFAC*! 

if(abs(D);gtTi;oi go to 54 

55 Continue 
iFACTRalFAC 
if(ntr;eq'.i) go to 60 

Ds«D 

60 DET»D 

INTR1{1)snTR 

return 

end 
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• DECK STCNR ,, -I 

OVERLAY tSTCi***’ 
program stcnr 
call REDINP 
return 


END 
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ooooon nooooocicj 


•DECK spaces 

subroutine BrACeS(X,Y,ANG,CURV,E,S,KA»KB> 

• BFACES BEAH fit EVALUATION Of ANQtEi CURVATUREi «»BFACeS» 

C E AnD S 

DIMENSION X(tO>,^(lO ),ANG(lfl);CURV*10)tBU0)*S(l0> 
input, 

X.Y u COORBINATES 

ANG - angle In radians (IF MA»1) 

ATJG(l)e estimated ANGLE AT THfi FIRST POINT (MAsO) 

ka,kb « first and last Index of variables x, y,ang,curv,e and s 

KD - STORAGE INCREMENT OF X';Y,ANG,CURV,E# AND S 
KORDER? 0 IP ERRORI IS TQ BE CALLED WHEN PTS ARE OUT OP ORDER 
* NON IeRO if return IS TO BE MADE FOR CORRECTIVE ACTION 


output- 

ANG • ANGCE in radians 

CURV *- curvature 

E P APPCtED FORCES a p/El (UNITS ARE 1:/L#*2> 

s B ARC Length along the ourvei id 

KORDERs index op ?no of adjacent out-of-order pts» not»o on entry 
common /cream/ MA,mB,XD»KORBER 

common /erase / A(3)#8(l)»YPBlli,DA(l)|ACH0(l),CHD(793) 

NK B kb 

Call beam<x(Ka) , Y(Ka) iANG(Ka>;(kb»Ka*kd)/kd> 

IF<KORDER;NE7o> go to 800 

C (KsKAJ 

I « 1 
K • » KA 
SK » S(K) 

E(K> s 6.«(B{ 1 )*YPB( n >/(CHDtn*CHD( I ) J 
C (KsKA.KBii) 

60 CURV(K>s (4;tB(n*2;«YPB{lM/eCHD<n*(l>i,5»B<IMB<im 
IF(KA-K) 65 »o 0*®0 
C (KsKA*l,K8-ll 

65 E(K> « 6;%(lB(l)*YPBm>/(CHD(i>«CHD(I)> 

I - fB(l«8)*ypBn»8i)/(eHD(I-8)»CHD(l-8))) 

C (KsKA*1,Kb) 

70 Sk a SK * CHD<1=8)»<1,*(BM»»85*BI I«8>-,5»0II-8)*YPB< 1-8)* 
i YPBn-0)«YP8{ 1*8) )/l57) 

S(K) B SK 
1F(K*NK) 80*^0*90 
60 I B i«a 

K » K*KQ 
IF(K-NK) 60i70i70 

C (KsKB) 

VO CURV(K)S(L2;*B(l98>-4,*YPB( i-8>i/<CHD(U8^•^l;♦l•5•YPB^-8UYPBU- 
l 8))| 

E(Kj s Ii8)*YP0{ U8i )/(eHD(l-8>*CHD( U8> > 

GO TO 900 

c Out op oroer pQ|Nts 

800 KORDERS KA+KORDBR-KD 
900 return 

end 
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•DECK ElLIP 

Subroutine eulip^xi, vi,angi;xj,y2,ang2,alphad) 

•fcULIP ELLtP and other SMOOTH DUMMY SUBROUTINES 

C subroutine to fit an ellipse given TWO points and the orientation 

Entry ellipT 

c subroutine to ftt an ellipse whose origin and dimension are given in 
c a rotated and translated coordinate system 

EnTrY XTrUnC 

C function to truncate XX TO AN EVEN MULTIPLE OF DX 
entry aTdmR 

c subroutine for augmented tridiagonal matrix reduction 
entry bad 

c subroutine to delete bad data by adjusting data lists 


entry CUBeR 

C subroutine to calculate Tpp !N terms of Y roR cubic spline equations 
c WITH arbitrary End conditions 

entry SmUlTi 

c subroutine to multiply triadiagonal and square matrix 

entry hypts 
entry HVPERI 
entry HVPBR2 
return 
End 
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nnoo oociooon 


•DECK REUOXy 

SUBROUTINE RElOX¥ ( 1 1 , 1 2 , NPTS* 

•REUOXY RELOCATE X, Y, ANQ.ANQBiOURViSiFQK »REL0XY» 

INPUT- 

U,i2 B index Range of segment data in xa#ya»arrays 
NPTS B nO or pts reqd for segment definition in X,Y*aRRAYS 
iMl 8 InDE* of first point of the segment In XiY-ArrAyS 

*m2 ^ Index of last point of the segment in x,y. arrays 

NIM s length of x,y-arrays 

N S segment index 

output- 

1M2 s index Of. last point in relocated x,y-arrays 
relocated Xi¥. . .«arrays 
adjusted IMAwIMB index limit values 


COMMON /CSEGME/ I A ( 10 ) i 1 8 ( 10 ) ^ IMAUO ) i IMB ( 10 ) , JTYPE ( iO ) • 
t N.NSEG, NIiNlS 

common ''cdS2 ^ X(100),Y(100);A!^G<100),aNGD(100),CURV(100), 
L ^ S(IOO) »FOK(iOfl)’.DEV(lO0) •CURVB(IOO) 

COMMON /TROUBL/ ERR, ERRMaJ, IN fiRR.PReRR 

LOGICAL BRR.ERRMAJ, INERR.PRERR 


NaDD s NPTS « (ISbII+I) 

IF = Im2*1 
It s if*naod 
NMOVE a N 1 M-Im 2 
IFINADDIge'.O} NMOVEe-NMOVE 
NIM a NIM*SaDD 
IF(NIm;LE'. 100 ) go to 30 
ERR » .true; 

WRITE ( 6 ii 030 ) 

Return 

1030 F0RMATI/1X67HS0RRY • THE NO*. OF OUTPUT PTS, EXCEEDS THE ALLOCATED 

•storage (200)1) 

30 lF(NMOVE»NADD.Eoi 0 ) GO TO SO 

Call move( 3 , x( in,x( iT),NM 0 VE»i, 

1 Y( IF) ,Y(IT) ,NM 0 VB,£, 

2 ANQUF), ANG(IT)»NM 0 VEi 1 ) 

Call move( 3 , aNgD(If),angd(Itj,nmovei 1 , 

^ CURV<IF),CURV<IT), NMOVE, 1 , 

^ S( IF) ,S{ IT) ,NMOVe,l) 

call M 0 VE( 3 ,’ F 0 K(IF),FQK{IT),NM 0 VEi 1 , 

7 DEV(IF),DEV(IT),NM 0 VE, 1 , 

^ 8 CURVB( IF), CURVBdT), NMOVE, 1> 

50 Im 2 a iMl ♦ NPTS -1 
IF( 1 M 2 ,Lt:IM 1 ) gO to 70 
DO 60 I 8 IM 1 ,IM 2 
DEV(I)s o'. 

CURVB( I )ao'. 

60 FqK(I)s o’. 

7 0 I mb { N ) a I m2 
NPl = N *1 

1 F(NPi;qt;nSBG) go to 900 

Do 8 q NNrNPl*NSEG 
lMA(NN)alMA{SN)*NADO 

8(j imbinn) = imb'(Nn)*nadd 


900 Return 
end 
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o o r> n 


•SERSi» 


•DECK SERSl 

SUBROUTING SlRSlIxi.Yl, X2,V2; k) 

• SENSl. MAcil series- 1 COUL CONtOUR 


INPUT- 

XI, Yl s COORBiNaTeS at HIGHLITE 
X2iY2 a COORBINATES ON COflL SURFACE 
A a X/X iilMIT POINT 


c output, 

c CALC VALUES OF X , Y , ANG , ANGD .CORV , S 


1 

1 


COMMON /CBEN 8 / NBC< 2 > i ANGE ( 21 , CURVE ( 2 J , FEND ( 2 ) 

COMMON /CPi / PI ,TW0P1 ,piq2;p!o4,todeg,torad 

COMMON /CSEQBE/ I A ( 10 ) , I B ( 10 ) ,’ IMA< 10 > 4 IMB ( 10 > , JTYPE ( 10 ) , 


COMMON /CDS2 

dimension 

equivalence 


NiNSEGi N1*N1S( 

X(100),Y(tOd);ANGa0O),ANGD(lOO),CuRV(lQ0) 
S<lO0>iFQK(iOO »VDEVUO0) ;CuRVB (10 0) 

ANGB(IOO) 

(ANGBiCURVB) 


I 


Dimension 


XSl (40 ) , YSl ( 40 ) VTSI I 40 > 


Data xsi/ 

•Om i 0 00l06,*,6o03062,, 0006461 1 70012996, i 0020031, i 0039664 , ,006002 
*| 008, .OlVjOlS. '.oa, ; 025 , ,03,:035';;04, 

<». 045, . 05, ;06t,07, . 08, ,09,.i;,l2'; 

• , 1 4 , , 1 6 , : 1 a , 7 2 0 , ; 2 2 , i 2 5 , , 3 , ; 3 5 . 

•,4,,45,;5;:6if;7,;8,.9,i,o/ 

n A T A ve, / 



2148291 

40087, 

00T97i 


c determine cut*off point, NPTS 

if(;o5,le1a 7and, a'.le.i;) go to 50 
write (6;i05fl) A 
Call errori 

50 DO 60 Xbj^7';4j 

. if(xsi(k);gt7a> go to 70 

6° NPTS a K 


c relocate arrays 
70 II s ia(N} 

I 2 = IBINJ 

B IMA(N) 

IM2 B lMB(n> 

CALL RELOXYIlliia, NPTS, 1M1,|M2) 
XR a X2*'X1 

TR a Y2iYl 

AR a Yr/XR 


74 



K ■ 1 

Do 120 l»lMlfcIM2 
I) ■ X1*X»*XS1(K) 

Y( I ) » Y1^Y«»YS1( K) 

^r(l.EQ’.lMl) qO to 115 
ANG(D« ATAN^AR»TS1J k) ) 

Do TO 118 
115 ANG(I)mPlQ2 

lie Angd( I )«AnjG( I )»TODEG 
120 K s K*1 

NbC( 1)= 1 
NBC(2)= 1 
ANGEU|«ANGDjlHl| 

ANGE‘2>«ANG0MM2* 

ANGB( IM1)»AN«( IMI) 

Call bfaces(x, Y t ak)gb»curv*pqk»s.' imi»im2) 

Call fhead^sI) 

WRITE (6;il50) Xl,Yl,X2iY2iA 
K a 1 

Do 160 I»IM1«IM2 

ANQB( 1 UANGan )*tooeg 
WRITE (6;il60) 

* XSl(K)i YS1(K)«XM )i Y( DiANGOei i*ANGB( I ) • CURV ( I ) i S ( I ) 

160 K , K*l 

Call MOVE(iiCuRvu^i).cuRVB(i0ii,Kf.i,i> 

Return 

1050 FORmAT(/ix70H*«* INPUT ERROR, PARAMETER A DOES NOT SATISFY ,05^A- 
•1,0 CRITERIA* A»F6,3,) 

1150 FqrmAt(/22Xi30H« NACA SERIES-1 COWL CONTOUR *//4X16H I NPUT DATAi X 
•l8F9,5,3X3HYlaF9.5,/l7X3HX2sF9;5,3X3HY2«F9,5,3X2HA«F6,3,///4Xl6HC0 

•Ordinate oata-//7ix,29h-^-w; beam calculated — ;-/iox3hx/x7X,3h 
•Y/Y14x,1hz1Ax,1hR9X,35hANGD AN6B CURV S) 

1160 ^ORMAT(7x;f’8';6,Pl0.5,f’l6.5,Fl5;5.F’U.3,Fi2,3,E 11,6,^10.5, ) 

End 
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o o o o n 


•DECK SMOINP 

Subroutine sboinR 

•SMOINP inpOt/output and special Contour routine psmoinp* 

COMMON PROGM(8),PROQ8v;nLlN,FlLOT.RErS(5) 

LOGICAL FTUNiFILQT 

COMMON /aDAH*!^ M AME( S > i AODRESIA) i T I TLEI 6 ) i IOENT < 6 ) 

Common /calcpt/ dxixmod 

COMMON /CalTS / BITS, BLANK 

COMMON /CeU,*T/ DZETA 

COMMON ^CLlNES/ LlNESiOMITFK^PTiTLEf 6) 

logical omitfk 

COMMON /CNtRL / K5 < I ) , STA <2 1 , t NcLUDt 2 ) » DELETE ( 2 M NSERT , CARRY 
LOGICAL carry 

equivalence tBOY,STA) 

Common /CPI / PIiTW0PI,Pl02^PfQ4iT0DEGiT0RAD 

COMMON /CSEQBE/ I A UO ) 1 1 B 1 10 > Xl MA (tO ) j I MB ( 10 ) • JTYPE ( 10 ) . 

1 N.NSEQ, NII.’NIM 

EQUIVALENCE (NliNIt) 

Common /csmooa/ deva(20)i fenoa<2oi»anqa(20IiCurva(2O) » narb 
COMMON /CSMOOB/ XA < 100 ) i YA ( 1 08 1'.'DE VI UOO ) 

DIMENSION ZA(lQ0),RAll08) 

EQUIVALENCE (ZA. XA) i (RA.'YA) 

Common /cds 2 / X(ioo)tmoo)*ANGaoo)iANGDaoo)iCURvaoo)i 
1 saoo),FQK(ioo);DEvaooj .cuRVBdoo) 

dimension DuMilOO) 
equivalence IDUMiCURVB) 
dimension Z(100)iR(t00) 
equivalence <ZiX|,(R,Y) 
common /TROUBL/ ERR/ERRMAJ.INBRR.PRERR 
logical BRRiEPRMAJi !N gRR,PRERR| ERRCAS 

EQUIVALENCE ( ERRCAS 1 1 NERR I 

logical upper 

dimension CNAMES<4) 

data CNAmeS/^90;i 992, •993,f99i;/ 

••• DEFINE The number or segments aNd the index limits 
NSEG * NUMBER OF SEGMENTS 

N 3 Segment index 

ia<n). iB(n)»limits of segment in the xa.ya lists 
TYPE(N)«TYPE of segment 

4 5 N ■ 1 

I s 1 

IJUNCtP 1 
GO TO 55 

&0 if{xa(I);eq;xa< i-i) ,ano, vA(n',EQ,YA(i-in go to 70 

55 iFIdNl) 60'l55tl55 

60 DO 65 J31,'4 

65 if<xa(i);eo;cnames(j^’ go to 75 
IF{ I lEQ. iJUNCn Go TO To 
I p 1*1 
GO TO 50 


c CONTOUR Juncture 

70 J PI 

75 JTYPE(N)'sj 
IA(N) 3 I - 
N 3 N*1 

GO TO (lloVltOil30il40),J 



ARBITRARY CURVE 
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IID 1B(N-I)a0 
I ■ !♦! 

Go TO 50 

C tLLIPSE 

120 ... 
irn 1*2'.Eq;n1) '.or, (XA( l*2i ,fiQ;XAn*3) ’.AND, YAM *2) ,EO , YaU+SM J 
♦IB(N’*1)sU2 
GO TO 150 

c spiral 

130 IB<N»-I)al*3 
GO TO 150 

C SERIES 1 

140 IB(N*-I>si*2 
1^0 I s IBtN*-!)*! 

IJlJNCTs I 
Go TO 55 

C BNd of input BaTAi TILL zero IB(N) 

155 NSEG a N-1 
lBIN-l>aNI 
Do 160 Nsl.NSEG 

160 IF(IB(Ni;EQ;fl) lB(N)tIA(N*l)-l 
RETURN 

C«»* FIT THE special COnTOURS 
ENTRY CONTRS 
DO 195 NsIVnSSG 
IMA(N)* 1A(N) 

195 lM8(N)a IB(NI 

NIM a IbINSeG) 

N si 

200 J 3 JTYPE(N) 

IFU.LE'.I) GO TO 790 

OMiTFK® ;true; 
call FHEAD(6} 
write <6li20l) N'BDY 
I a 1 a(N1 

12 4 IB(NI 

IM 5 IMA<8) 

IM2 ^ iMBtN) 

XI B XA(1*1) 

Yl a YaIH^U 

1F(N,LE;i> go to 206 
XI a X(IM»1) 

Yl a Y(IN*U 

206 X 2 s XaU^B) 

Y2 a YA(Il2> 

IF(N,eQ;NSEQ ;or, JTYPE«N*1).NE:1> go To 220 
X2 a X(I«2*1J 

Y2 a y(IM8*1) 

220 1F(1H;Le;d so to 222 

ANGI a ANGDMM-t) ........ 

222 IF((12-I)'.EQ73 .AND', < XA( 1*3) V’NE, BITS, AND , XA ( U3 ), NE , 999 , M 
• AnG1#XA{I+3) 

IF( iMaiGE’.NiB) qO to 224 

ANG2 a ANG0tlM2*l) _ 

22^ IF(n29l)'.EQ73 .AnD', ( YA{ 1*3) 7NE. BITS ,AND, YA( 1*3) ,NE .999, ? ) 

« ANG2*YA(J*3) 
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lF(J-3> 290.300,400 


c FIT THE Ellipse 

250 call ELLIPOCl.Yl.AMQl, X2,Y2,*NQ2, YAU)) 
IF(ERR) GO TO 7’0 
DIET A a 5',*TQRAD 
CALL ELLIPT 
GO TO 790 

c FIT THE Hyperbolic spiral 

300 IF( YA( n .EO'.t; ) GO TO 320 

call HYPERKXI* Y1. ANGI. X2.y2.ANG2) 

GO TO 350 

320 CURVl ® YA(It3^ 

CALL HYPER2(X1.Y1. ANGl.CURVl. X2.Y2) 

350 IF(ERR) go to 790 
CALL HYPTS 
Go TO 790 

C SERIES 1 COWL LiP. 

400 Call serskxi.yi. X2,y2, va(U) 


C index to the next SEGMENT 
790 IF(ERR) pRRCASf '. true, 

Err a .false* 

N A N*1 

If (n.le'.nseQJ So to 200 

C IE ERR has bESn encountered, do not write output file 

IF( .NOTiERRCASi SO TO 800 
ErrmAjb ,tRUE'. / 

errcas* .false* 
return 

c make The curvalineaR distance continuous 
800 Ds * o’ 

Do 8O5 Ia2,NlM 

IF(S( I ) iEQ.O. ) DSbSM*!) 

805 Scl > a S( I )tOS 


c*»» write total computed data For the boundary 
OMITFks .true; 

WRITE^U^iBoO) n ,S< P iX< n *Y<n.ANGD( I) .CURV8( 1) ,FQK{ n»Ial*NlM) 

1800 FQRMaT</21X24HC0Ns0L1DATED OUTPUT DATA//4X59HI ^ a 

a Y'ff ANGD CURV FQK/4QX7HDEGREES/ ( 2X , I 3, OPFIP , 5 

•. 2 FU. 5 ,F 9 ’, 3 kF 10 ; 6 iF 10 , 5 , ) , ) 


RETURN 

1040 FormAT(/1X59H**« ERROR .* NUMBER OF INPUT POINTS (XA»YA) IS LESS T 

1042 F0RMAT(/1X34HINPUT TAPE RETRIGVAL INFORMATION »//2X7HF0UN0 Al 3|)^ 
1202 FORMATI/8H SEGMENT . 1 3 » 9H OF BDva,A6/26H — — r*.»- 

• ) 

End 
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ocicincicio cionooorjocionoci 


•DECK SMOO 

SUBROUTINE SnOQ 


•SMOO-i 

C 

C 

C 


ANQViE# curvature and arc length •SMOOP 

OF A smooth curve PA8S!nQ close TO GIVEN POINTS 
THE SMOOTHING OPTION HAS NOT BEEN INCLUDED, INSTEAD, 
CURVE IS FITTED TO THE GIVEN X,Y POINTS, 


NA 


NA 

NA 

Na 


INPUT*- 

MEANS NOT available IN THIS VERSION 

IA,IB B range of index IN LISTS XA , YA , DEV 1 , DEV ,X , Y , ANG , CURV ,E , S 

xA list of input X 
YA s list of input Y 

Devi = list of point movement parameters 

TORQl f TORSIONAL SPRING COMPLIANCE » FIRST END 

TORQN 8 torsional SPRING COMPLIANCE - SECOND END 

NBC<L)s boundary condition iNBiCATQR FOR FIRST(L*1> AND SEC0ND'L»2 

a 0 V l»i OR 2 

AnGE(L)s angle in DEGREES* IF NBC(L)al 
CURVElUaCURVATURE, If NBC(L>aJ 

FeNDIlI^RaTIG of SHEAR FORCE, END/NEXT TO END INTERVAL, IF NBCIU 


noteS, 

The Units of xa,Va,devi ,toroi and torqn must be the same, 
fqr exampeV inches, devi is proportional to the cube root of 
The spring compliances, torqs are directlyproportionaltothe 
end torsional spring compliances; larger values of DEVI YeILD 

LOWER APPLieO FORCES (AND GREATER DEVIATIONS), LARGER VaLUeS OF 

Toro yield LOwer applied end roments, 


OUTPUT 


C 

Na 

DEVaV A 

c 


X,.Y a 

C 

NA 

AnG c 

c 

NA 

AnGD a 

c 

NA 

CURV a 

c 

NA 

FqeI a 

c 

NA 

S a 

c 

NA 

Ed a 

c 

NA 

ET a 

c 

na 

RMSDEV*? 

c 

NA 

RMSF a 

c 

NA 

RMSFI a 


BASED ON adjusted POINTS* „ , ... 

DEVIATION FROM THE INPUT POINTS IN THE NORMAL DIRECTION, IN 
ADJUSTED coordinates 

Anglo in radians 
anglO In degrees 
curvature, i/in 

applied forces, delta YPPP, 1/IN2 
length along THE CURVE, IN 

energy of equivalent springs under deflection dev, l/IN 
SPRING energies, I/IN 

root mean square deviation of points with devi.ne.o 
root mean square VALUe OF F/EI, 1/IN2 
root mean square VALUfi of F/EI for unadjusted BEAM 


common /ccurv / 
common /cb / 
dimension 
equivalence 
dimension 
equivalence 
Common /cbenO / 
equivalence 
Common /ccubE / 
common ^csegre/ 

COMMON /cSMOOb/ 
common /CbS2 / 

dimension 
equivalence 
common /csmood/ 
Common /erase / 
dimension 


NNi IDIM,G(2) 

A < 2 ) 

U(2) 

lUjG) 

V(lOO) ,W<tOO) 

(Wi V) 

NBC(2),AnGE(2J,CURVE(2),FEnD(2) 

INBCJ.,NBC),(NBC2.NBC{2)» 

NBCSI2>,SAVSU>;FENDS<2) 

IIA(IO) ,iiB(10>';jMA(l0i;iMBtl0) .jTYPEaO) , 

NiNSEGiNI *NIM 

XA<lOO),YA(lOfl)VDEVl<100) 

X(IOO), Y< too); ANG<X00>,ANGD« 100) , CURV (100 > , 
9(100),FOK(lOfi);DEV(l00).CURVB(100) 

E(IOO) 

tEiFQK) 

sgamma,szetai;szetan 

H{8,100) 

CHD(B,99), Giei80>,GN(lOO), INTERKIOO) 
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EQUIVALENCE < CHD | H < 8 » 1 > ) » ( I NTERl i Gl . H ( 1 , 1 ) ) , (QNiHUii^)) 
Common ''csmooe^ gamma(IOO) 

COMMON /TROUBL/ ERRi errmaj. inErr. prerr 
logical Brr,errmaj,inerr,prerr 

dimension BNDPAR(3) 

data EN0PaR/5hFENDA,4HANGA.5HCURVA/ 

C write OUT END CONDITIONS 
ANGE{l)»FENOUI 
ANGE(2)sFENDf2) 

CURVE(l>»rEND(l) 

CURVE(2)aFENB(2) „ , 

WRITE (6;i020) ENDPAR(NBCi*l>*FBND(l>i ENDPAR(NBC2*D |FBND(2) 

1020 FormAt( 10X*47H* A CjRVE HAS BEEN FITTED TO GIVEN XiY POINTS *// 

1 6x,i8HBNo Conditions - , a5;4h<Up»f9.5» iox,a5i4H(2)»,F9,5) 

•HI2)sf9;5;) 

lA a I IA(H) 

IB a IIS(N) 

NPTS a I8-I4*1 

IaB s NPtS 

c CALC Forces.' f/ei, applied to the beam which passes through points 
Call bfaces<xa.ya, ang,curvb.e.s;ia, ib> 
call M0VE(2.*A(1A),X<IAJ,IAB»1. YA( 1A) »Y( IA> .IAB.I) 

I a I A 

K a I 

405 ANGD< I )aANG| I)*57,29578 

415 K a K*1 

1 * !♦! 

IF(NPTSwK) 430.405,405 
C SMOOTHING LOGIC HAS BEEN REMOVED 
430 WRITE (6,1100) 

write {6#1110) (XA< I) ,YA{ I ) .DEVI ( I) »DEV( I ) iX( I ) .Y( I )*ANQD( i7* 

1 CURVB( I ),FOK(n,S(I}, I>IA. IB) 

1100 FoRMAT(72x.'10X. iSHAPPLIED ARC/6X17HINPUT COORD I NATESl7x, 20HAD J 

•USTED COORDIRATES22Xi17hFORCES LENGTH/7x89hxA » ZA YA;rA 

• DEVi DEV X.Z Y.R ANGD CURV F QK 

4 S/33X;37H#1000 DEGREES) 

1110 FORMAT(2x;2rli;5rF7,2,3pr7.2.0P8Fll,5,F9'.3,Fl0,6,2Fl0,5, ) 

return 

End 
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•DECK SmOTH 

Subroutine smotw 

MAlS PROGRAM FOR SMOOTH 


•SMOOTH 


^EaD input; determine number aNd type °F segments 
Call smoinp 


c smooth arbitrary Segments 
Call smoxeo 


calc SpEClAL*CONTOUR SEGMENTS, WRITE O^JTpUT 
CALL CONTRS 

Return 

end 


•smooth* 
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•DECK SMOEXQ 

subroutine SHOXEQ „ « 

•SMOXEO arbitrary segment smoothing RSMOXEQ* 


Common /cbitb ^ BitSiBlank 

COMMON /cbENB / NBC(2),ANQE(2J,eURVE(2) ,FEND{2) 

COMMON /CNTRU / K5 ( 1 > i ST A 12 > • INfcLUOf 2 > i DELETE (2 ) i I NSERT *CARRY 


equivalence IBDY.STA) 

COMMON /CSEGME/ 1 A < 10 ' 1 1 B(10 > . IMAIIO ) 1 1 MB { 10 ) . JTYPE 1 10 » • 

I N.NSEG, NII.’NIM 

EQUIVALENCE <Nl|Nll) . . „ 

COMMON /CSMOOA/ DEVA<20), f ENOA 1 20 > , ANGA 1 20 > '.CURV A < 20 > , NARB 

COMMON ^CSMOOb'' X A ( *-0® ) i Y A( 10<* )',*DEV I ( 100 ) 

COMMON /CDS2 / X ( 100 ) i Y ( 100 ) . AnGUOO > i ANGD ( 100 ) ♦ CURV ( 100 ) i 
1 S( lOO ) iFQK(lOfl)','OEV*100) iCURVBciOO) 

COMMON /CLINES/ L I NES * OM I TFK# PT iTLEt 6> 


LOGICAL OMITFK 

COMMON /troubl/ erRiERRmaJi inerr»prerr 

LOGICAL ERRiERRMAJ.INSRR.PRERR 


LOGICAL 

EQUIVALENCE 

LOGICAL 


ERRCAS 

(ERRCAS, INERR) 
DONE 


C«*« SMOOTH arbitrary CURVES 
NSWEEP® ). 

170 Done * .jrue; 

AnGREFo 0. 

N B 1 

NaRB a 1 

175 IF( JTYPE<N)«1) l89|176il90 

176 I B 1a(NJ 

I2 9 1B(N) 

C end conditions 
DEVI 1 1 1*0'. 
devki2)3o; 

PEND(1)»0 . 
rBND<2)*0'. 

NBClDi 0 
NBC(2 )s 0 
L s 0 

180 LL 8 NaRB$20*L 

ir(FENDA(LL)VEO;BlTS) GO TO 181 
NBC(1)= L 
FEND{1)8FENDA(LL) 

181 If (FENDA(LL*1) VeQ.BITS) GO TO 182 


C 

C 


C 


N8C(2)* L 

FEND(2)=FEND*(LL*1) 

182 L = L*1 

IF(L,LE’.2) QO 180 
CHECK for undefined END CONDITIONS 
ENDsl 

IF(FEND<1)’iNe'.999, ) GO TO 184 


IFIN.EQ.l) GO TO 187 ^ ^ 

IF{ JTVPE(N-I) ,GB,0) GO TO i87 
IFINBCm iEe'.U FEND(U*ANGDn;i* 
IFINBCd) .ED.2I FENDdJaCURVtiBlI 

end. 2 

184 IF(rEND(2>’,SE;999, ) GO TO 186 

IF(N,GE nSBS),GO TO 200 
in JTYPE(N*f ) 'GStO) GO TO 1®7 
IF(NBC(2)’.Efi'.l) FEND<2)sANGDei8*l) 
lF(NBCt2>'.ED;2l FEND(2)*CURVn**l) 


/ 
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IF(DEvA(nAR 0J ‘.NE.BITS) DEV I ( I) = DEV Af NARB ) 

*F(DEVA(NaRB?1) ’.NE.bITS) DEVI tl0)«DEVA(NARB*l) 

omitfk» .true; 
call FHEAD(l^*l2il ) 

write (6»1186) N*BDV 
S(I) a O', 

ANG< I >« ANGRBF 

call shoo 

JTYPE(N)s;i 
12 s IB(NJ 

ANgREF8ANg(I1> 

Go TO 18B 

187 Done « .false', 

186 IF(ERR) ERRCASb’.TRUE, 

« IfAlSe'. 

189 naRB NARBI2 

190 N s,N*l 

IF(NiLE.NsEG) go to 175 

RETURN TO 176 TO LOOP THROUGH SEGMENTS AGAIN 
TO PICK UP THOSE WHICH HAS UNDEFINED END CONDITIONS 

if(done) return 

NSWEEPs NSWEEP^I 
IF<NSwEEP',LE7iO) go to 170 
200 write (6,i200> 

ERRCASa’.TRUE? 

RETURN 

1186 FoRMAT(/ 8H SEGMBNT|13»9H OF BDvs,A6/26H 

• ) 

1200 FORMATdXSOH*** ANGA.CURVA * 999 END OPTION USED INCORRECTLY) 
END 
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•DECK RBD 

subroutine rbd 

•RBD — - read in boundary DATA •RBDP 

INPUT- 

ENDBDTft end OF BDY^STC TAPE RECoRDSi T OR F 
ENOCRDt End of all stc card inputi t or F 

K6SV s value of KEY(6> OF LAST RECORD READ FROM TAPE 

Restptb Restart (with existins tabUeS) is true only 

IF CARD BDY-DATA HAS «0t YET BEEN ENCOUNTERED 
STCFIl* t if a stc-subfile exists on TAPEPORGF, 

OUTPUT- 
ENDBDTb 
K6SV » 

RESTPTs 


integer REFS,8DY,CHN 


c 


boundary Table 

INDEX- LBsLBfiOiLBDE 

LBNEXTb increment to next boundary 

LBZI s increment to the first boundary point (so before COALLATIO 
CWNaMEb channel with which the boundary data is associated 
up a X OR F- POR UPPER OR LOWER BOUNDARY 

LEDEX s relative index of l;e; point when lower and UPPER surface 
contours are connecteb 

bdname,lba;lbb«name and index limits of specific boundary 
OA jA when boundaries ARE COALLATED 
common /CHDATa/ BDT(l),LBNEXT(lI,LBZiai, 

1 CHNAME(1)iUP(1)VlEDEX(1)* 

2 2BT(l),RBT(i>.ANGBT«42) 

LOGICAL UP 

integer BDTkCHNAMEiBDNAME 

DIMENSION BDNAMEai.LBAdliLBBU} 

EQUIVALENCE (BONAME I'ZBT ) • (LBAiRBT). (LBBiANGBT) 


COMMON /BCOMMN/ RROGM ( 8 > i PROGSV.TlLINi F ILOT 
LOGICAL FIL]N#FlLOT 


common /al'LcOm/ 

1 

2 

REAL 

LOGICAL 

COMMON /IXORIG/ 

ft 


DIMENSION 

equivalence 


MACHA|RSA(TSA»PTA|TTAi aXIAiRGAiGAMA* 

MACHCiPSC»TSC;PtC,TTC* AXIC.RGC.GAMC; 

DAXIT.SCALEA.TTE.CHOTST 

MaCHA(I) iMACHC 

AXlAiAXICiCHOTSt 

LHO.LHE. LBDO^LBDEi LTO.LTE. LHO.LWE, LFO.LFE. 
LOiLESTA, LDUM(8), 

HO.NM. NU»NFCOL8» MAXNJ, mAXOL . HAXNM. MAXLEi 

LEOiLEEi lro.lre.lrd 

LIM!TS(24) 

<LIMITS»LH0) 


COMMON /ADAM02/ 
LOGICAL 

COMMON /'CBITS / 
COMMON /Clines^ 
LOGICAL 

COMMON ?CNTRL ^ 
EQUIVALENCE 
COMMON /CPI / 
COMMON /CREDfN/ 

equivalence 


BNDJOB.NUMPLT.'PL'OTED.ENDCRD 
BNOJOB, PLOTED.ENDCRD 

bits, BLANK 

LINES. 0MITFK.PT!TLE(6> 

OMITFK 

K5, BOY (6), insert. CARRY, BHN 
tBOYiIBDY) 

PI tTWOPl iPIQ2»P!04iT0DEQ.T0RAD 

2TRaNS,RTRaNS;ROTaTE,ZPivOT.RPIVOT,SCaLE,Nb,TaB{9) 
(XTRANS,ZTRaN 8);(YTRANS,RTRANS) , <XPIVOT,ZPlVOT)| 
IYPIVOT.RPIVOT) 


1 
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Common /ctapos/ restrt,endbdt,stcfil»k6sv 
LOGICAU RESTRT,ENDBDT*StCFIL 

COMMON ^ERASE ^ 8(800) 

Common /spacer/ maxlh»mAxlt.maxlfimaxi.w 
common /TROUBL/ cRR,=RRHaJi inBrr.prErr 
LOGICAU ERR.ERRMAJ.INERRiPRERR 

C smooth commons 

common /AOAMQl/ N AME ( 6 > , ADDRES( 6 > . T I TUE( 6 > i IDENT ( 6 ) 

Common /calcrt/ DxiXMOD 
COMMON /cELLRT / DZETA 

COMMON /CSEGME/ 1 A < 10 ) • 1 BUO > i’lMA< 10 ) i IMB<10) . JTYPE<10) .N.NSEGi 
1 NIIiNlM 

EQUIVALENCE (NliNlI) 

COMMON /CSMOOA/ DEVA ( 20 ) i FEnDS(20 ) i ANGAt 20 ) . CURVA < 20 ) , NARB 
COMMON /CSMOO0/ X A (1 00 ) i Y A ( 1 08 j .'DE V I ( 100 ) 

dimension za<ioo),ra{ioo) 

EQUIVALENCE <ZA,XA), ( RA.'YA) 

COMMON /C0S2 / X ( 1 0 0 ) » Y ( tOO ) • A nG( 100 ) i ANGD( 100 ) » CURV ( 100 ) . S < 1 00 ) • 

1 FqK(IOO) .DEV(IOO) ,CURVB{100» 

DIMENSION Z(100’|R<100>.DUM(100> 

EQUIVALENCE ( Z i X ) i ( R ,¥).'( BUM , CURVB > 

COMMON /BlBD¥ / BLB<60> 

Dimension i8L8(60) 
equivalence /IBlBiBLB) 
logical bl 

data LBLB/1/ 

logical DATAIN.ENDBDC. UPPER, zronly 
Data kbdy/shboy/, khigh/6B / 


Namelist /a/ 

8, 

NB, 

TAB. 

dblpts. 

ZRONLY, 

1 

bdy; 

CHN, 

upper. 

X , Z , 

Y , R , 

ANGD, 

2 

rotate; 

ZPIVOT, 

RPiVOt, 

ZTRANS. 

rtrans, 

scale, 

3 

FLIP^ 

ident. 

XRI VOT, 

YPIWOt. 

XTRANS; 

YTRANS, 

DUM 

4, 

DX, 

XMOD, 

DEVA,' 

FENDA, 

ANGA, 

5 

CURV A ; 

ZA,XA, 

ra*ya. 

DEVI.’ 

Nil . 

DEV, 

6 

7 

« 

ang; 

UPPER 

,CAPX1,8L 

CURV, 

curvb. 

FOK.' 

S. 

NIM, 


c definte double point tolerance* DPTOL 

DPTOL S 1'.E-5 

c initialize 

c endbdcb End of bdy card input* t or f 
EnDBDCx .false’. 

lF(K5.NEi KB0¥ '.or. ENDCRDI ENDBDCF , TRUE i. 
18 DaTaIN* ,FAL-8e’, 

DBLPTS® ;oi 
JFOUND* 0 
CAPXI = o'. 

BL s IfaLSE’,. 
c read bdy input Cards 

35 IF( EnDBDC ) GO To 40 

flip = 1. 
rotate? o: 

ZPIV0T3 o'. 

RPIVOTC 0*. 
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SCALE s SpALBA 
ZTRANS* 0. 

RTRANSa 0*. 

Zronlys .false’. 

Call setm(1»71i devi.ioO) 

CALL SETM(3iBlTS»XAi 200iDEVA*8o'.Bi3eO) 

Call setM(i,bits#Xi200) 

READ (5;a> 

IF(ZRONLY) CALL I SORT ( XA , if A ,’DUMVBi 200i 2 J 

,not;zromly ) call isort(X.v»angDiB;30o.'i) 

IF<INERR) ERRMAJ^.TRUE, 
datains .true; 

RESTRT* .false'. 

c COUNT the length OF THE Z?>L1ST 
^0 IF( .NOT’.DATAIN) Go to 900 
IF( JFOUNd '.EQil ) GO TO 43 

Nl =0 
DO 41 laiVlpd 

IF(XA( n . eQ.BITSJ go to 42. 

41 Nj a j 

42 1F(NI ;EQ: oJ go to 43 
lines a 64 

call smoth 

JFOUNOe 1 

43 N2 so 

DO 45 Iai;i00 

1F(Z( 1 ) '.EQ'.BfTS) GO TO 50 

NZ a I 

50 IF(NZ-2) 55*l00il00 
55 WRITE <6;i058) B0Y(1) 

errmajs ’.true*. 

Return 

c delete double points from smooth boundary records 
100 omitfk* .true; 

CALL FHEaD(NZ*10) 

WRITE (6.io9fl) iBOViCHNiUPPERiSL 

1F(JF0UNd;ne';i .or, DBLPTS;eQ:o; .or, Nz’,Le;2) go to iso 
write (6,1100) DBLPTS.DBLPTS 
I SI 

110 ^ e Ul 

*F(1 ,gT;Nz) go to 150 

iF(ABs(Z( I )-2< i.i) ); ge,optol 7or ; 

1 ABS{R{1)-R(1-1)).GE,DPI0L) go to 110 

ANGOlFa ABS ( ANGD < I ) • ANqD ( I- l ) } 

IF (angdif;gb;dblpts) go to ito 

NMOVE = NZ^l 

AnGSV a .5»{*NGD( 1 )*AnGD( I«1)1 

IF(ANgD( n«A«GD(Ni) jEQ.o; '.ANd; ANcDIFiLE. !o005) ANGSV^O. 
ANQD( I»1 )saNGSV 

CALL M0VE(3,’ Z< I*1)iZ( I )iNMOVEti. 

1 R(I*U,R<1 J.NMOVg.i. 

2 ANGD(I*l)|ANGO(n,NHOVEil) 

NZ a NZ-1 

Go TO 110 

c calculate curvatures for printout 

150 I a 1 

CURVdIao'.O 
l55 CURVBdiaBiTS 
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CURV( l*l)aCU*V( I) 

DX « Z(i*t).Ztl ) 


DY s R(l*l)«Ril) 

s SQRTtDX«Dx*DY«DY) 
IF(CHd;Lt'. ’. 00001) QO TO 160 
ACHD s ATAM3(DV,DX, ANGD( n.TORADJ 
YPA s AnGD(I )hTORAD-ACHD 


YpB s AnGD< I* i)«TORAD-ACHD 

CURVB{ I )s(4;tYPA*2,*YPa)/(CHD»<i>l,5*YPA«VPA) ) 

cuRv< i*i)3Ui;«yra-4,*ypb)/<chd*(i.*i,5«ypb«ypb) ) 

Go TO 165 


160 lr(I,EG;i) GO TO 165 

IF(Curv 8 ( i-il IE q.BITS) CuRVB(1»£)«CURVB( 1) 
165 I s 1*1 


IF{ I ,LT;Nz) 80 TO 155 . 

CURVB( I Jsq’.O 

•REL013 relocate FROH A ONE TO A THREE DIMENSIONED ARRAY RREL013R 
c Subroutine RgLOij 


INPUT- 

2«R s boundary coordinates 

ANGD s angle OF THE BOUNDARY (DEGREES) 

Nz e number of boundary coordinate points 

f^LiP * scalEr on R(I) before Rotation or translation 

rotate* angular rotation in degrees 

ZPI VOT»RPl VQTsPf VOT POINT FoR ROTATION BEFORE SCALING 

scale b multiplicative constant on input coordinates 
ZTRANS a Z*TR«NSlAT I ON AFTER SCALING 
RTRANSs R*TRAnSLATION after scaling 
BDY s boundary name 

upper s t if upper boundary.' » f if lower boundary 
chn s channel Name 

LBDE b next available location in the boundary TABLE 


OUTPUT- 

bdt 8 Table of z.r.ang in 3,d array form 

lbde s next available location in the boundary table 

if(flip;ne;i;;or, rotate, ne:o." ’.or, scale, NE. i, .OR, ztrans;ne;d, 

1 .OR, RTRANSTnE'.O. ) write (6.1151) FL I P, ROTATE, ZP I VOT, RPl VqT; 

2 SCaLe.ZTRANS.RTRaNS 
WRITE (6,1152) 

LBl a lbde 

t-B2 a lB1*3»(NI-1) 

UB 8 LbI 

BDT(LB>3BDT 

CHNAME(LB)aCHN 

LBZ1(LB)sO 

UP(LB)8 upper 

LEDEX(LB)sO 

I a 1 . 

L8DEL 8 3 
ADDPI 8 o'. 

IF( .NOT'.UPPER) GO TO 240 
UB 8 lB 2 
•-BDEL 8 i3 
ADDPI a PI 

240 ROTAT b R0TATE*T0RAD 
SN s SIN(ROTAT) 

CS 8 CpSlROTAT) 

250 IF(ROTATE.NE.O* ) GO TO 260 
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ZBT(LB)«Z(I )fSCALE * ZTRANS 
RBT(LB>*R( ! )#FUP*SCALE * RTRAN8 
GO TO 2^0 

260 RFLP K R( I )#FUtP 

ZBT(LB)»<ZPIVOT*CS*{ZU ) *ZP I VOT ) -SN# ( RFlP-RP I VOT > ) «SCALE * ZTRANS 
RBTaB)»(RPlV0T*CS*(RFLP.RPlV0T>^SN#(Z{i)-ZPlV0T))*SCALE ♦ RTRANS 
270 AnGD( I )BANGD il)*FLlP ♦ ROTATE 
ANGBT(LB)3ANJD< 1 )#T0RAD ♦ ADDPl 

WRITE (6;i280) I »ZBT(LB) ,RBT(LB» »ANGD( I ) ,CURV( I) ,CURVB( I ) 
If(liGE.NZ) GO TO 300 
I » 1*1 

l-B = LB*LBDEL 

GO TO 250 
300 lboE b LB2*^ 

LBnEXT<LBi)8LBDE*l31 

BDT(LbDE)sBUANK 

end Subroutine reloi3 


SET UP boundary layer INPUT TABLE 

IBLB(LBLB)b IsDY 
ISLB<LBLB«1)<i 0 
1F( BL) IBLB^lBLB*!)*! 
BlB(LBlB*2)b CApXl • 

LbLb 8 LrLbIS 

900 return 


1055 F0RMAT(//iX48h*« NO COORDINATE INPUT tfAS FOUND FOR 
1090 F0RMAT(///1X«45 hB OUNDARY COORDINATE 
• 5X4HCHNsA6i jX6HUPPERs 


BDY«A6»//I 
S, BDY*A6, 


«L2,6X,3HBLsLi. ) 

1100. F0RMAT(/6X46RD0UBLE POINTS WITH ANGLE DIFFERENCES LESS THANF6.3.1X 

«24hare Eliminated (oblptssf5';3;2H),) 

1151 F0RMAT(/6X5HrLlPAF7;3i3X7HR0TATEsF8,3i3X7HZPl VOT bFiO, 5,3X7HRPIVOT5 
, _„*^11.5,3X5HSCALEF7;3,3X7HZTRANS»F10,5.3XTHRTRANS»F10,5, ) 
ii5<f Format i/9xA8hi x#z y#’r angd curv» curv* i 
1260 f"ORMAT( Iio;2PiO,5,Fio,3i2Fio,«> 


End 
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•DECK CRBD 

Block data RfloBiK 

•CRBD-- block data FOR RbD ROUTINE 

•SMOBLK SMOOTH BLOCK COMMON 

common /csmood'' sgamma,S2etai;szetan 
data SGAmmAiSZETAI.SZETAN/ lhi‘.E2,l,E2/ 

^ NQ 


PCRBDP 

•SMOBlK 
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•DECK RCD 

SUBROUTINE RCD 

•RCD’^^m RE40 IN channel DATA »RCD® 

INPUT.- 

chdatas channel Input data table 

LHE 5 NEXT aVaILABL LOCATION |N CHANNEL. INPUT DATA TABLE 


OUTPUT- 

LCHE s next AVAILABL LOCATION IN CHANNEL INPUT DATA TABLE 
CHDATa?. channel input DATA TABLE INCLUDING NEW INPUT VALUES 


channel Input data Table 


1 

2 

A 


index- LHsLHO.LHE 

Common /chdata/ chnam(I) »lhnExt<ii »wtflow( 

TsO(i) ,Pso(i ); machoii>iaO( 

RG(1)iGAM(1I. NR(1)<NC(i), 
BB( 75) 

LOGICAL VARY 

integer CHNAM 


DIMENSION 

REAL 

EQUIVALENCE 


VQ(1) 

MACHO 
tVO, MACHO) 


DiTTOUIiPTOa 

1)*VARY(D* 

TAB(6)i 


)• 


common 

LOGICAL 

Common /cao / 
Common /cbits f 
Common /CNtRL / 
integer chn 

EQUIVALENCE 
Common /ctabrr/ 
common /ctapos/ 
logical 

Common /spacer^ 
Common j^TROUlL/ 

common /IXORIG/ 

tt 

A 


dimension 

equivalence 


PR0GM<8) .PROGSV.TlLINiFlLOT.’RErSlS) 

FILINiFILOT 

Adsv 

BiTSiBlANK 

K5iCHN(6)»INSERT 

(ICH.NiCHN) 

IlTAB 

ReSTRT,ENDB0T;enDFIL»K6SV 

restrt,endbdt;endfil 

maxlhiMaxlt;maxlf»maxlw 

ERR»ERRMAJi IN gRR.PRERR 
Err, ErrmaJ, InBrr.prErr 

lho.lhe, LBDO.'LBDE, lto.lte; lwo.lwe; LFO.LFE, 

LOiLESTA, LDUM(8), 

MOiNM» NJ*NFC0LS* MAXNJi mAXOL * MAXNMi MAXLE i 

LEOiLEEi lro»cre*lrd 

LIMITS(2A) 

<LIMITS#LH0) 


Common /erase 


DUM<16) ,B<784) 


Namelist /a/ chniHTflOw.ttovtt.ptOjRt, 

X TSOiPSO, MACHO , AbifVARY, 

^ gam I RG I 

3 NR,N8,TAB,B 

RESTART Case with channel flow data REVISIONS 
Relocate chdata for channel*chn into first position 
First find index lh for chnam»chn 

LH e I.HO 

12 IF(LH.GE.LHE> so to 20 • 

IF(CHNaM(LH)7eQ;CH'N) go TO 14 
lh « LH*LHNEXT(LH) 

Go TO 12 

lA *F(LH;eQ,LHOJ go to 16 
LNG s LHNEXT<LH) 
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IHI B LHO*LnG 

LH2 b lh*l5q 

I-H3 8 Lm2«LNG 

Caul M0VE(3i CHMAM(LHO>,CHNAMtLHl>iLHO-LH£.l,l, 
i CHf4AM(UH2) iCHNAMeUHO»#LNGil, 

CHHAM<Lh3),CHNaM(Lh2),LHE*LNG*Lh 3*1,1> 
16 LHNXT » LM0*tHN6XT<LH0> 

GQ to 30 


20 Call moveci, chmAmiChnah(21),lho-lhE'»i#i) 
LHNEXT® 20 
LHNXT s 21 
LHE 3 LHE*20 


c initialize 

Call SETMtlf BITS iWTFLOWiIO) 

VARY s ‘.trub; 

c read chn input Cards 

30 call SETMd.’BlTs; 8,400) 

R E A D ( 5 , A ) 

AOSV s aO(I-H) 
irUNERR) ERRMAJ^ .TRUE, 

c RESET CHNaM IF CHANNEL NAME HAS BEEN REDEFINED 

CHNAM b chn 

C COUNT the length OF THE B.ARRAV 

NR 3 0 

NCI s NC 

DO 40 i»i;4oo,nci 
„ IF(B (1 liEo'.BlTS) GO TO 3 q 

40 NR s 

50 NCR 3 nC*nH 

c relocate and Insert b-arrax into chdata.table 

if(ncr;eo:o) go to 950 

LHNXTTs LHO*IO*NCR 
NMOVE 3 LHE-liHNxT*! 

1f(LHnXTt;gT7LHNXT) NMOVE»-NMOVe 

Call move(2, chnah(lhnxt),chnamilhnxtt),nmove,i, b,bb,ncr,i> 

LHE 8 LHE*LHNxTTbLHNXT 
LHnEXTs 20*NCr 


950 IF(LHE,LT;lBDO) GO TO 980 

write (6:i960> LHOiLHE.MAXLH.LBDO 
Call errorI 
980 return 


I960 F0RMAT</1x81H*** THE CHANNEL INPUT DATA TABLE HAS EXCEEDED ALLOTT 

Increase haxlh:/6x4hlho«m,3x4hlhe»i4,3x6hmaxlhbi4»3x 

»5HLBD0sI 4 ) 

End 
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•DECK REDINP 

subroutine REDINP 

•REUINP STC read input PREDINP* 


COMMON /BCOMMN/ PROQMI 8) ,PR0GSV';FIU|N',TILQT 
LOGICAL FfUNiFlLOT 

COMMON ^ADAMfll/ N AME ( 6 ) , ADDRESt *> i T I TLE I 6) , 1 DENT ( 6 ) 

COMMON /ADAM02/ BN D JOB • NUMPlT •PL'OTBD » ENDCRD 

logical endJob, ploted.endcrd 

common /ALLCOM/ HaCHA,PSA,TSA*PTA,TTA, AXIAi'RGA.GAMA, 

^ MACHCiPSC,TSC;PtC,TTC, AXICVRGCiGAMC* 

* DaXITiSCALEA.TTE.CHOTST 

LOGICAL AXI,AXIA,AXIC;CH0IST 

REAL MACWA(t) ,MACHC,MACH0(1) 

EQUIVALENCE ( MACHO i MACMC) PSOi PSC> » { TSO» TSC ) i { PTOi PTC ) » 

& ITTOiTTO# (AXIVaXIOiIRGiRQO.IGAMiGAMC) 

COMMON /BENDIN/ HBC I N < 2 ) i ACF ( 2 1 

common /caira / bitsiBlank 

common ^CCRX ^ CRXSL.CRXOL;CBXSS,CRXE,CRXCiDCRX 

dimension CRX{6) 
equivalence tCRXiCRXSL) 

Common /cenD / tblenD(2) 

common /CgRAV / CG 

COMMON /ClAOfN/ RhOB AS , RHO AMP I ADM 

COMMON /CINNBR/ InRCTR, RDUM,‘N lNNER<16 > i CNVF < 16 ) 

Common /cisB8t/ farfld(2)»free(2)iPres(2>ipspisv»nzp« 

« zPdOiiPSPiioj.NzPi 

dimension PpSllO) 
equivalence (PPSiFSP) 
integer FARFL0.FR8E;P!IES»PSPISV 

common ^CIVP * IVP,VPDUM,NRFt2),lNR(2);xiVP(2) 

Common /ClwoSv/ lwosv 
common /CMAXIT/ MaX I T , MA JCTR , QRBF IN, TL 
LOGICAL GREFIN 

EQUIVALENCE ( MAXR6F , M AX I T J 

Common /cntrL / K5»sta(6i,insbrt 

common /CPLOTi/ PlOTjSaMeXY; XScALE(4),YSCALErA)* XORg.YORG, SX^SY 
LOGICAL PLOT.SAMEXY 

equivalence <IPL0T,PL0T) 

Common /cprint/ PD0{6>*PDUM(2fl>. 
equivalence (Pf^TES2,PDD) 

COMMON /CPRPRN/ PRPRN 
integer PRPRN 

Common ^cptmov^ velpot, icoBVNOoeNSiFBASTQ 

LOGICAL VELPOT 

common /CREFlN/ DREF I N, SG21;V9G1 , VMB2 , NGR , NGZ, SGR ( 10 ) , GR< lO ) » 

4 SGZaO),G|<iOj 

common /css / SSFML,SSEF,SSeAN6,SSDF,SSFEND,SSFNDl, . 

4 DSS<2I|RH0W;RH0WSS,TSIC;RH0C,RH0CSS 

integer SSFML 

LOGICAL SSEF, SSDF 

‘common /CTAPOS/ RESTRT.STCFIL 
LOGICAL RESTRTiSTCFiL 

COMMON /CtE / TOLWF, TOLWFU*' tEX12, TWFi TERHF, JRET 
COMMON /CTHICK/ NTHKX , NTHKY.’THKX < 25| , THKY 1 25) , JH I K2D( 2S0 ) 

COMMON /CTOLRL/ TOLRU i MAXSWP. CLGN, PTOLRl . T0LES2, NSWP,' 

4 DS1DMP,DSXDP1;DT0UR2<4) ,SQlREF,TOLINR 

COMMON /files / 0RGr,UPDF,NgWF,8CRF 
INTEGER QRGP,UPDF,N6WF,’8CRF 

COMMON ^IXORIG^ LHO.LHE, LBDO.LBDE, LTO.LTE^' LW0,LWE; LFOiLFb; 

^ LOiLESTA, LSOiLSEt LDO.LDE. LDUM(<)» 

4 MOINM* NJ»NFCols* MAXNJ,mAXOL»MAXNMiMAXLEi 
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dimension 

EQUIVALENCE 
COMMON /K^YS / 
COMMON /SLTA0 / 

integer 

COMMON ^SPACER/ 
COMMON /TROUBL/ 

logical 


LEO.uEEi LROiLRE.LRD 
LIM 1 TS< 24 » 

UIMITSiLHOI 

KEYAUOIiKEVBeiO) 

M(128),X2a28J,8LCHNa28> 

8 LCHN 

MAXlHiMAXLT'/MAXLTiMAXLW 
ERRiERRMAJ, iNfiRR.PRERR 
ERR,ERRMaJ, INBRR.PRERR 


COMMON /CHDATA/ 

common /CB / 

COMMON /cm / 

Common /cr / 

COMMON /cSl / 

COMMON /CS2 / 

COMMON /CVM / 

Common /cz / 

logical 


TABLES(2046) 

B{768> 

JMS(768> 

RF<768) 

SK768) 

S2< 768) 

VMF(768> 

ZF(h^) 

FIRST 


Data ka/iha/» kbdy/shsdy/, kchn/3HChn/, ksta/3hsta/ 
Data first/t/ 

common / cNORM / RHLiRM, AHL .'AIM 
COMMON /Tapes / ntapo.ntapn 


common /BlBDY / BL3I60) 

Dimension i8Lb(60> 
equivalence /IBLBiBLB) 
integer bnam 

COMMON /ViSCfiS/ TREFiMUREFiSCON 

real muref 

Common /rebl / RESTbl 
Logical restbl 

stcfil= t if a stc^subfile exists on TapE“ORGF. 

Namelist /a/ identi 

* macho,pso,'tso.pto,tto, axi,rg;gam,scale;tte.chotst, 

I NBCiNjACr; CRXSL,CRXOL,CRXSS,CRXE,CRXC,CRX, 

* CG, RHOBAS^RHOAMP, lADM, ! NRCtR# Nl NNER, CNVF , 

* farflDifree«prbs,?spisvinzp.2p;psp,pps,nzpi, 

« NRFi INR»X1V».MXLRLX. 

« HAXREF,MaXIT,NRBFTn,TL, RN, BLOT,1PLOT,SaMEXY,XSCALE,YScALE, 
« PRTES2iPDD,RDUMi 

f PRPRN, VECROT,1 cOB,NODENS'FBASTG, 
a SG21,VMG1;VMG2 ,NGRiNGZiSGR,GR,8GZ|GZi 
« SSFMLiSSEF;SSEANG,SSDF|SSFEND»SSFND1| 

& RHOW,RHowSS«TS1C,RHOC,RHOCSS; 

8 T0LWF,NTHKX*NTHKY,TMKXiTdKY.THfK2D| 

8 T0LRL»MAXSWP,T0LES2,DS1DMP;DS1DP1|SG1RBF|T0LINR# 

8 MAXLH,MaxLT»MAxLF,MAXLWi 

8 LIMITS, tables, B , JMS , RF , Si ,*SS , VMF,ZF i W,X2,‘SLCHN 
*» TREF, MUREF, Scon iRML I RM, inpblR 


c** 


initialize and Read overall iaj input data 
iF( .N ot, first ’.and, (ks.ne’.ka ’,or, bndcrd)) go to 200 
IFIFIrST .and. K5.EQ.KA) go to lOO 
WRITE (6’,iOO(J>- 


err » .true; 

PROGSVs 0. 

Go TO 200 
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100 PROGSVB o’, 

EnDBDTs .FAlSe'. 
iNPBLRa 0 

First s .false, 
lines s 64 
NRefINs 0 
NTHKX = 0 
RESTRTa jTRUe; . 

STCFiLa .FALSE. 

Call setm(1»bits» machoisi 


c determine field array size 

MAXLE a L0C2 <TABLESiTBLEND) 

MAXNM a L0C2fRF,2F) 

C RE/vD input file 

120 IF( .NOT’.FILIN) 60 TO 130 

Rewind ntapo . , 

read (NTaPO) STCFILi(LIMITS(n. 1^1*2^) 
LWOSV a LWO 
IF(STCFIL) go to 125 
ENqBDTs .true'. 

WRITE (6;il20) 

GO TO 130 


! “1 » 16 ) I vturuT # 1 LUP, 

, InRCTRiDREFINiSG 21> 
■,SSEANG*SSDFiSSFENDi 


(SlCHNI I J # Ial#NJ) • TOLRL iMAxSBP.TOLES2iTOL1NR*D! 

(DT0LR2( I ) .tsl.’A) (SGIREF. 

(CRX( I) ,181*6) , RH0BAS,RH0AMP,1ADM,NTHKX,NTHKY, 
(THKX(I)i I»1i300)»T8LWF1 

check to SES if stc.a input data exceeded dimensions 

IFINM.GT'.LOCKRFiZF) ,0R , LESTA* GT,L0C2(TABLES,TBLEND> ) 
1F( lde’.ne'.o ) RESTBL=.TRUE’. 


ERR^.TRUE 


C read card input 

130 read <5iA> 

DO 135 Is1;D 

135 IF(MACH0( I ) .SE.BITS) MACHA( I )*MACH0< I ) 

C DEFINE, the CHARACTERISTIC LENGTH',' CLEN 

142 ClEN s SQR<D 

IF(NGR.LE'.I) GO TO 146 
Do 144 Is2*N«R 
144 cL£n s clen^sgri 1 ) 

146 IF(NGZ;lE'. 0> GO TO 149 
Do i48 UiVnSZ 

148 CLEN a CLEN|SGZ< I ) 

149 CLEN * CLEN/FL0AT{NGR*NGZ) 
lF(SGlREr.EQ"0. J SGlREFalO .*CI:EN 


1F( INPBLR'.EQTO) go to 155 
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C RfcAD BL INPUT CaRDSIFIKED) fORM^kT 
Do 155 IslViHpBLiR 
read (5*156) BNAMiCAPXl 

156 format (IXi A10iFl0,6) 

C SEARCH BL table FOR ENTRY 
. IBL * *2 

157 IBL a IRL*B 

iFdBLBf IBL>:eO;8NaM) qO TO 1J8 

1F( iBLBCiBLr.EQ’.IBITS ,0R; I8L‘.GE,5a ) GO TO 155 
Go TO 157 

158 IBLB( IBL+1) • 1 
BLB( 1BL*2) » CAPXl 

155 Continue 

SET UP INDEX-ORIGIN TABLE IF THERE IS NO STC-TAPE INPUT 

order of tables in block common 

LH ''CHDATa/ 

LB /BDYTAB^ 

LT /CONVTB/ 

LW /WAKETB/ 

LF /CADJIifF/ 

L /STATRB/ 

IF(STCFIL) RETURN 
RESTRTa .FALBE’. 

LBDO 8 LHO*MAXlH 
LbDE a lbDo 
RETURN 

C (OTHER index LIMITS ARE SET \f\ SUBROUTINE BLDTbS) 

c read Boundary data 

200 Gall rbd 

IF(ENDCRD) go to 700 
IF(K5.EQ.KB0V> RETURN 

c READ Channel Bata 

300 IFIKS'.NE.KCHU) go to 400 

c IF restrt, unpack Tables to make room for new chdaTa and convtb, 

IF{ .NOT.RESTRT ‘.or; LBDO.Gt, CLHE*!}) GO TO 350 
MOVEl a lOC2{TABlESiSI)"LESTA 

M0vE2 » MOvBI/2 

LWTD a LWOtMOVEl 
L8T0 s LBDO+MOVE2 

Call MOVE(2x TaBlSS(LWO) iTABLEs(LWTO)iLWOaLESTA-l,i, 

1 TABLES (LBDO »*TABLES(LBT0),LBD0»LTE-1,1) 

LBDO 8 lBOQ*MOVE 2 
LTE a LTE?MOvE 2 
LBDE a LBDB+MOVE2 
LTO a Lt0tM0VB2 
LWO a LW05 mOVB 1 
350 CAj.L rCD 

Return 

400 WritE(6i1690J K5 

ERRMAja .true; 

RETURN 

C construct LETEPT, ORTCHN, convtb; SLTAB, STaTaB AND the field table 
700 IFIERRMAJ '.OS; LBDE'.EQ.LBDO) ERR»iTRUE, 

900 return 

1000 FQRMAT(/iX73yERR0R» The K5sA INPUT DATA DOES NOT IMMEDIATELY FOULO 
•W the PRogMbBTC CARD) 
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1120 

1136 

1690 


^ormat(//ix43h*«« no stc data tound on 
F0RmaT(/29H §»• NZP exceeds DIH of (10)) 
rORMAT(//lX44H«* PLEASE CHECK THE INPUT 

^^IT MUST BE 0NB/6X37H0F THE FOLLOWING^* 
ENq 


THE input tape.//? 

value of. K5 (K5«a6;i 8H) 
At BDYi CHNi STA;//) 
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•deck BuilDt 

0VERLAy(STC,1.2) 

Program Buildt 

COMMON ^CMAXlT/ 

logical 

COMMON /CPRtRT/ 

Common /trouAl/ 
logical 

Common /select/ 


MAXlT,MAJCTR,GREriNiEDUM 

grefin 

PRTES2,PRTb,PRTA.»»REFIn.PREFN2,SSON1C,PDUM(20) 

ERRiERRMAJ. IN6RR»PRERR 
BRR.ERRMaJ, IN fiRR.PRERR 
LEMTRY 


Go To (9^io;i5) , LENTRY 

5 Call bldtab 

Go TO 20 

Call bpsort 

MAJCTRs 0 

insert special Boundary 
Call isbot 

IF(ERR) CALV ERRORl 

20 RetuRn”*^^* edump 

End 


types in twe station table 
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•DECK BlDTAB 

SUBROUTINE BLDTaB , • „ . ^ r- dt t*oic 

• BLDTAB COALLATB BDY-TABLE. BUILD LE*^TE PT TABLE 


•BLDTaB* 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 


input- 

boundary TABLE. ^BDYTAB/ 
channel input Date, /chdata/ 

OUTPUT^ 

condensed boundary table, /bdvtab/ 
ordered edge POINTS, /LETEPT/ 


BOUNDARY TABLE 
INDEX. LBbLB60.LBDE 

lbnexts increment to 
increment to 
channel with 


LBZI s 
CMNAMEs 
Up s 
LEDEX s 


AND UPPBR SURFACE 


THE^F?RST boundary point (=0 BEFORE COALLATIO 
WHICH the boundary DATA IS ASSOCIATED 
T OR F FOR UPPER OR LOWER BOUNDARY 
relative INDEX OF L'.E; point when LOWER 
CONTBURS ARE C0NNECTE8 

BDNAME.LBA.LBBsNAME and INDEX LIMITS OF SPECIFIC BOUNDARY 
DATA WHEN BOUNDARIES ARE COALLATEO 
COMMON /chdata/ BDT(1) .LBNEXTtU .LBZKI) . 

1 CHNAME(l) .UP(l) .’lEDEX(I) * 

2 ZBTa),R8T<l);ANG8TM2) 

LOGICAL UP 

integer 8DTkCHNAME,BDNAME 
DIMENSION BPNAME(l) ,LBAtl) .LBBU) 

EQUIVALENCE ( BDN AME i ZBT ) » (LBAiRBT), (LBB.ANGBT) 


1 

2 


COMMON /ALLCOM/ 


REAL 

LOGICAL 

COMMON /IXORIG/ 


MACHA,PSA,TSA*'PtA,TTAi AX I A . RGA. GAMA , 
MACHC.PSC.TSC/PTC.TTCi axic.rgc.gamc, 
DAXIT.SCALEA.YTE.CHOTST 
MACHA(l), MACHS 

AXlAiAXlCtCHOTST . r. 

LHO.LHE. LBOO.LiDE, LTO.lTE. LW0,LWE> LF0,LFE. 
LO,LCSTA, LDUMiBI, 

MO,NM, NJ.NFCOLS, MAXNJ.MAXOL ,MAXNM,MAXLE , 

LEO, LEE. LRO.LRB.LRD 
LIMITS(24) 
iLlMiTSiLbO) 


DIMENSION 

TABLE^OF^LEADtNG EDGE ’ AND"tRAILING EDGE POINTS 

T-.E-. COINCIDENT PJS- 

chliChu^name of Channel above and below pt. respectively 
BDL.BDU»B0UNBARy names associated with the points .n.rrHwy 

NUSED s COUNT OF TIMES THAT POINT USED IN CONSTRUCTION OF /ORTCHN/ 
COMMON /LETEPT/ XE.( I ) . YE { 1 > ;aNGE ( 1 } , NLE ( 1 ) , NTE ( 1 ) , 

1 CHLU).CHU<i>.BDLU>.BDU<l>.NUSED(49l) 

INTEGER CHL.CHUiBDL.'BDU 


cOhm°n /cbits 
COMMON /CPI 
COMMON /ERASE 
DIMENSION 

equivalence 

INTEGER 


/ 

/ 

/ 


BITS.IBLANK 

PI .TWOPI .PT02,Pi04,T0DEG.T0RAD 
xx<1),yy,angg.nL»nT,cnl.cnu.bnl.bnu,nzero 
IXX(IO) 

UXXjXX) 

iiNicviCP. GNL.CNUiBNLVBNU 

COMMON /TROUBi,/ ERR.ERRMAJ.INERR.PRERR 
logical ERR.ERRMAJ.INBRR.PRERR 

integer aBl.BD2.BNAME2»CHN;HL0 WER.HUPPER.' upper 

logical wall 
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Data hloweR*huppbr/5hloweRi5HUPreR/ 

C relocate BDY-TaBLB down and AD3ACENT to CHUATA-TABLE 
NMOVE » LBDE-lBDO+1 

CALL MOVEdi BDT(L3D0) ,BDTa'He*i) .NMOVE, 1» 

LBDO S lhE*1 

LbDE s LHe*NMOvE 

C define double point tolerance, DPTOL 
dptol * i;e-5 

boundary Table sort 

c Relocate together the eouNOARfEs which belong to the same wall 

L8l S lBDO 

305 LB2 s LB1*L8NEXT(LB1) 

IF (Lb 2;GE',L8DE> QO TO 350 
c COMPARE CHANNElj. NAME AND UPPER|L'OWER > WALL 

310 1F(CHNAME(L9I) .NE.CMNAME(LBI) .or. <UP(|,B2) ‘.and. . NOT , UP ( LBl ) ) 
«* .OR, (UP<L91) '.and, ,N0T,UP(.LB2i) ) GO TO 340 
C DOES LB2 follow LBl, COMPARE THB Z.R VALUES OF THE END POINTS 
LI 8 L81*LBNEXT(LB1)59 
IF ( ABS (ZBT( LB2 )-ZBT( LI ) ),LT; dptol ,AND, 

1 ABS(RBT<LB2i-RBTtLl> ) .LT'.DPToD GO TO 315 
C DOES LB2 PRECEED L3l 

L2 8 L92*LBNEXT(LB2)-9 

IF( ABs(ZBT(L 2)^ZBT( LBl n,G£'. DPTOL »0R. 

1 ABS(RBT(L2)-RBT(LB1) ) .GE’.DPTOLJ GO TO 340 
LI * LBl 

GO TO 316 

315 LI 8 L0l*LBNEXT(L8l) 

316 NB2 8 lBnEMT<L;B2) 

LT 8 Li*NB2 

L2 s LB2 *Nb2 

L22 a L2*NB2 

IF(LB2;Eq;lI)G 0 Tn 340 

call M0VE(3. BDT(Ll)iBDT(LT).i:iil^LBDE,i, 

1 BDTIL2>,8DT(L1),NB2,1, 

2 8DT(L22I,BDT<L2>;LBDE^L2*1,1> 
iFai .eq.lbiJ go to 30’ 

340 LB2 s LB2*LbNBXT<LB2) 

IF<LB2,LT'.LBBE) GO TO 310 
LBl 8 LB1*UBNEXT(LB1) 

Go TO 305 

c«« coallate The Boundaries along one wall into one contour 

350 LSI s LBDO 
355 NCOAL s 0 

CHN 8 CHNAMEIlBI) 
wall 8 uP(L 81) 

360 LB2 8 LB1*UBNEXT(LB1> 

IF(LB2;ge'.LB0E '.or, BDTILB2I .BQ'.IBLANK) go TO 400 
c IS THIS BOUNDARY CONTINUED 

lF(CHNAMEa9*r*N6,CHN ,OR. (UP(L*02) .AND; .NOT. WALL) ,OR, 

* (WALL iAND. .N0T.UP(LB2) ) ) QO TO 380 
Ll 8 L0l*i;aNEXT(LBl)-9 
L2 8 LB2*UBZI<L32> 

IF(ABS(ZBT(Li)-ZBT(Ll) ) ,LT| dPTOL .AND, 

I A8s(RBT<Lf)"RBT(Ll) ) .LT. DPTOL) QO TO 365 
c error, boubdart Table not continuous 
IUP=HlOWER 
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lr( UP(LBl> ) 
WRITE(6«1365) 

1 

Call errori 


Til 9 ** LJ P P £ R 

I Up’chmAME <LB1 ) .'ZBT<L1 ) i RBT ( Ll > • ZBT ( L2 ) • 
RBT(L2) 


move The LBI Z.R.ANG-DATA up 6 spaces if there exists 
generated at boundary junctions; ^/7l) 

365 Ugp S 6 , . 

IF(aNgBT(l2)'*EQ.ANGBT(L1)) lUPsO 
LF ® L81*6*L8ZKL91) 

LT = \,F*LUP 
NMOvE s -( (LBl*LBNExT(LBin 
BNAME2= BDT«LB2> 

LNEXT28 LBNEXT(LB2) 

LSTARja LBZlfLB2l 


LF) 


CALL MOVEdi BDT<LF)»BDT(LT)*NMOVEi1) 


IF(NCOAL.nE'.O) go to 370 
NCOAL = 1 

BDNAME(L81)=BDT(LR1) 

LBA(LB1)slBZ1<L81) 

LBB(L81)sL0AiLBl)-NMOVE-3 


370 Ll a L01'>3»NCOAL 
BDNAME(Ll)aBMAME2 
LBA(Ll)aLBNE*T<LBl) ^ ^ 

LB8(Ll)aLBA<Ll) * ( LNEXT2» < 4*LSTART ) ) 
N - NcOAl- 

NCOAL a NCOAL+1 


*• 3 


375 IF(N,LE'.0) go TO 377 
Ll a L01*3*(N*1' 

LBA(L1)?LBA(U1)*LIIP 

LbB{Li)sLbB(1^1I*1''J^ 

N a N-l 

Go TO 375 

37 7 LBNEXTaBl)sli8NEXT(LBl)*LNEXT2 
LBZ1(LB1)sL8ZKLB1)*LUP 

Go TO 360 


c eliminate gaps , ^ 

3B0 If(NCOAL,EQ.8> GO TO 390 

LDOWN s LBZi^LBlJ - 3»NC0AL 
IF(LDoWN*lE'.0) go to 390 
LF s LBlt6 + LBZKLBl) 

LT _ , = LF-LDOWN 

NMOVE a LBDE«LF*^ _ 

call M0VE(1. 8Dt(LF)»BDT(LT)»NM0VEH) 

LBNEXT(LBl)aUBMEXT(LBl)-LDOuN 

LeZllLBl)8LBZl<LBl)-LDOWN 

N a 1 

3B5 Ll a LB1*3 *»(,NsI) 

LBA{L1)bLBA,(L1)-LDCwN 

LBB{Ll)*LBB<lil)-LOOWN 

N a [y|*i 

InN.LE’.NcOAli) SO TO 385 
LBDE a LBDE»LD0WN 
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c INDEX To The next lBI 
390 LBI a LB1*LBNEXT(LB1) 
lF(LBiiLT*LBDE> GO TO 355 

• initialize far field interface Boundary data i 
400 Call ffinit 

build leading edge/trailing edge point Table. 

LEE * LEO-l 

LB a LBDO 

405 Ll a LB*L8Z1(LB> 

LL a Ll 

L2 a Lb*L8NEXT(LB>«9 

GO TO 410 

0 SEARCH FOR SHARP CORNERS 

407 LL a 1 L*3 

IF(ABs(ZBt(LL)*zBT<LL” 3 ) ) .LT.BPTOL .AND; 

1 ABS<RbT(LL)-RBT(LL-3) ) .LT.BPTOL) GO TO 408 
IF(LL;LT;l2) go to 407 
Go TO 4io 

c sharp Corner 

408 ZBT(LL>*ZBT(UL-3) 

PBTaDsRBTlLL'^) 

NZERO a ;i 

NL a 0 
•^T a 0 

ANGG a ;5»(ANGBT(LL)*ANGBT(LUi3) ) 

Go TO 412 
410 NZERO a 0 

ANGG a ANGBT(LL» 

412 Call setmiii iblank. cnliAJ 

XX a Z0T(LL) 

A RBTILL) 

IF(UP(LB)) GO TO 415 


420 

425 


425 

420 


•ESORTP preliminary edge POINT SORT 

c Subroutine esort 


lower Boundary 
cnl a CHNAME<LB) 

BNL a BDT(LB) 

if(ll .eq.i;i) go to 
if(LL;eo;l2) qO to 
G o to 435 
upper boundary 
415 CNU a CHNAME(LB) 

Bnu a BDtiLB) 

ANGG a ANGQ-PI 

IF(LU*EQ*L1) GO TO 
IF(1-L,eO,L2) gO TO 
GO TO 435 


C LEADING edge 


420 

nl 

a 1 



a 0 


Gq TO 

435 

C 

trai 

L-I^G EDiE 

425 

NT. 

■ 1 


nl 

a 0 

C 435 

Call 

ESORTP 


REQPD 

/letept/ 
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INPUT* 

XX(10)B data vector to be INSBRTED into ARRAY-XE 
XE 9 array op vectors sorted according to first two elements 
LEOiLEEb index limits of the XB«ARRAy 

output- 

XE B revised Array of edge points 

LEE B revised upper LIMIT OF XE*»ARRAY , 

c search for ordered position - j 
A35 continue 

J 8 0 
55 1 a i 

60 Lf g 10*J * I»1 * ^E® 

IF(LE.GE;lEE> go to 80 

XD B XXlIlyXElLE) 

1F( ABs(XD) .LE. <l.l»TTEn xDb07 

IF(XD) 8o;78k65 
65 J a j+i 

Go TO 53 
70 1 sj*l 

IF( I iLE’.2) go To 60 

C THE NEW point IS COINCIDENT WITH POlNT*J 
l-E 9 ip*J * lBO 

ANGE<LE»a.5B(ANG6<LE)*ANGG) 

NLE{LE>«NLE(liE)*NL 
Nt£(LE)8NtE<LE)*NT 
I 8 6 

72 Le 10«J ♦ 1*1 * ^£0 

IF( IXX(I) '.NEVIBLANK) XE{LE)«XX(!> 

I , P 1*1 
‘F(I,Le;10) ®0 to 72 
C RETURN 

GO TO 436 

C relocate and insert THE NEW LINE IN LINE-J 
00 LEF P IObJ ♦ LEO 
LET 8 LEF*10 

call M0VE(2» xE(LEF) »XE(LET)*1:EF-LEE-1»i. 

1 XX,XE(LEF),10,1) 

LEE f LEE*10 

c return 

c End •»•»«»••»«««« 

* 

436 1f(LL*L2) 407,440,407 

c Increment boundary table index 

440 LB o LB*LBNEXT<LB) 

IFILB.LT.lBOE) go to 405 

c check for a minimum of 4 points in the letept. table 

IFMLEE-LEOtIi'.lT.AO) call BRRORl 

Cp final sort of /LETEPT/ by average flow angle 

tang b 92'./80;*PI(32 
LEj, a LEO 

454 NcOuNTb (LEEJIbLeD/IO 

455 LE2 8 LEI 
460 LE2 p LE2*10 

if(le 2 ;ge'.leE) go to 470 
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C IS PT2 IN PROMT OF PTl (VECTOR PTl TO PT2 GT 90 DEG FROM SL ) 

ANGSU P ;9*(AMGE(LEi)*ANGE(LE2)i 

AnGi2 p AtAN«(YE<LE2)»YE<LEl) ixe(LE2)'XE(LEl) »ANGSL> 

lF(ABS(ANQl2i^ANG8L),l,E,TAMQ| qO TO 460 

C MOVE PT LE2 In promt OE lEl 

LI * LEI 

UT p Li*lfl 

L2 s LE2*10 

L22 p L2*10 

call M0VE(3i' XE(L1 ),XE(LT),Ll«liLEE,li 

1 XEeL2),XE<Ll),i0a; 

2 XE{L22),xE(L2);LEE»L2*1,1> 

NCOUNTs NcOURT-1 

IFCnCOUNT'.GBToI go to 455 
write (6;1468) 

CALL ERRORl 

c index lei 

470 LEl s lG1*10 

IPILEl.LT'.LEfi) GO TO 454 

* combine upper and lower contours CONNECTED BY L.E, IN THE BDYaTABLE 
Lei AND Lb2 are INDICIES OF THE TWO CONTOURS 
(LOWER AND UPPBR SURFACE) 

LUP P additional space reqd For subtable of included boundaries 
LE p LEP , 

472 lF(NLE(LE).Ni.2) QO TO 496 
BDi p BDU(UE) 

BD2 ■ BDL(LE) 

LBl p LbF(BDI) 

LB2 p LBF<BD2) 

c check l;e; angle discrepancy 

LB P LB2pL9ZKLB2) 

ANGD2 m ANGBT(LB)»T0DEG 
NBD2 p BDf(U82) 

Lb i Lb1*UbNeXT(Lb 1)«9 
ANGDl a ANGBT<LBJ»TQDEG 
NBDI p BDT(LBl) 

IF<ABS(ANGD2pANQDD;lT, ,1) GO TO 474 
ANqdAVp ,5p{ANG01*aNgD2) 

WRITE {6,i47l> ZBT(L8 IiRBT(LB NBDI i NBD2 i ANGDl i ANGD2, ANGDAV 

1473 Format (//52H ••• error ^ the boundary angles at LfE. point z •, 

1 Fio;5,4H R p»FlO,5//l«x;i7HARE NOT THE SAME, 

2 33H THE AVERAGE VALUE WILL BE USED*. //21X , 7HBDY « ,A6,6X. 

^ 7hBDV p f A6/21x,5HAN6D*»FBi3#6j(,5HAN6D»»F8.3//29X, 

4 8HAV8-ANGa,F8,3J 

ANGBT(LB)aANftDAV»TORAD 

C make ROOM FOR SUBTABLE OF INCLUDED BOUNDARIES 

474 LUP P MAX0#3,LBZl(lBin ♦ MAX8 ( 3 , LBZI ( LB2 )) s LBZl(LBl) 

LB p LBIpU'BZKLBII 
LT p Lb*LUP 

Call moveu,' zbt(lb) ,zbt(lt) »LB* 5-uBDE,i) 

LBDE p lbdb^lup 
IF(LB2,GE.LBI) LB2sLB2*LUP 

c Included boundaries in countour lbi 
IF(lBZi(lbiI7nE;0> go to 479 
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BDNAMe(LB)»BDT<LB> 

LBA(LB)a LUP 

LBB(l.B)a lBA|lB)*l3nEXT(LB)®9 
Lb a lb* 3 
GO TO 480 
47!? LBNl a lbI 
476 LBA(LBNl)aLBA(LBNl)*l.UP 
LBB(LBN1 )sLBB(LBN1)*LUP 
LBNI s LBN143 
iFaBNl'.LT'.LB) QO TO 476 

UPPER surface CHANMEL MAME IS STORED ON TOP OF PUPP 
LEDEX a INDEX OF LEADING EDGE PT ON THE CONTOUR 
480 CHNAME(LBl*lJaCHNAME(LB2) 

LEDEX(LB1)»LBB(LB-3) 


C INcUUdBd boundaries in CONTOUR LB2 

IF(LBZ1<L82>';nE, 0) GO TO 485 
BDNAME(LB)aB0T(i:B2) 

LBA(U8)=lBB(LB"3) 

LbB(Lb ) aLBA<L8)*LBNEXT(LB2)i9 
Go TO 490 

c relocate index limits of upper boundaries 

48S> LBN2 a lb2 

LBDIF a LBB(La-3)"LBA(LB2) 

486 BDNAf^ElLBIaBtiNAMEdBNa) 

lbaIlbI'ilba^lbnzUlboif 

LB8(LB>8LBB(LBN2>*LBDIF 
LB a LB*3 
LbN 2 a LbN243 

IF<LBN2;lt*. ILB2*LBZi(LB2) )) GO TO 486 


C 

C 


490 


494 


Relocate lb2*coordinates into lbi-countour, ' NB2aNuHBER of data 
Points to be moved, 

N82 a LBNeXT<LB2)-LBZl(LB2>-9 
LI a LB1*LBNEXT(LBU*LUP 

Lt 5 LUNB2 

L2 a LB2*liBZl<LB2)*9 

L22 a LB2*LBNEXT(LB2) 

IFaB2iLT.LSl) GO TO 494 

Lb 2 a Lb2*Nb2 

L2 a L2*Nfl2 

L22 * L22*NB2 

LBZKLBl)aLB2l(LBl)*LUP 

LBNEXT(LBi)8l»BNEXT(LBl )*LUP*NB2 

Call move('3,’ bdt<H i ,bdT(LT) ,li;i-Lbde,i, 

1 BDT<L2)|BDT(lI>.NB2,1i 

2 BDT(L22) ,BDTaB2> ,1:BDE*NB2*1"L22,1) 

L8DE s LBDE*N02!-(L22*LS2I 


49!? 

496 


Do 495 LEXaLEOiLEEilO 
IF(BDL<LExKBq‘,BD2) bdl<lex)sbdi 
LE a lE*^® 

iejle.lt.lee) Go to 472 


RETURN 

1468 FORMATI/ixTOlilERROR. THE L.El# TIE, AND BOUNDARY POINTS CAN NOT BE 
•ordered ACC0RDING/8X64HT0 ORTHOGONAL NUMBER! PLEASE CHECK S.L, AN 
aGles in TABUS-LETEPT, > 

1365 FORMAT(///ix8H»» THE3X , A6 ,*lJi25HB0UNDARY CONTOUR FOR CHN»A6 ;iX17h 


104 



«IS NOT C0nTINU0uS/6X9HAT POi NTSfll , 5 » IH , FlO . 5 , 1X3HANDF11 , 5 , IH i F lO , 
•5 ;iH,/6X59HTHE FOLLOWING TA8LB CONTAINS THE BOUNDARY COORDINATE IN 
•Put; ) 

END 
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a n ci cioooo 


•DECK BpsoRT 

Subroutine brsort 

•BPSORT BOUNoARV POINT SORT ^BPSORT* 

s^aT ion Table 

INDEX- LsLOiLESTA 

SCHOKEp station choke indicator (ADJWFiBRHS.WRIOUT) 
ncl 8 SHARP Corner indicator (BlDtbs) 

mcl = fielB Index of control streamline (ptmove»flobal) 

Common /ChDATA/ Xl(U*LNEXT(l)*MLB(l>iMuBa>iPRlM<l>i 

X TvPELBlD.NAMBLad), ILB(l),FLB(l),SlLB(i)i 

1 TYPEUB(I) .NAMEUBd) , lUBIl) ,FUB(1> |S1UB<1>| 

® VmB(1),DWDV(1)iX2cU(1)»SLSWI (1)iMClU)» 

^ AnGTE(I) iPTTEili.PSTEdJ *FGRTE(1) iRGTE(1)i 

« ANGEXP<1),BSQEXP<475) 

dimension CRVLE<1) lANGLfiti) 

equivalence (SCHOKEiDWDV)*‘(CRVLE.ANGTE) . ( angle.pttei 

integer PRiMiTYPELB.'TyPEUBiSCHOKEIlJ 

field tables 
Index- MsmOiRh 
Common /cz / Z(300) 

COMMON /CR / R(300) 

Common /cs2 / S2<300) 

Common /csi / si(300) 

COMMON /CPHIl / PHIK300) 
common /cm / JMS(300) 

COMMON /CCURV / CURV<300> 

COMMON /CB / 0(300) 

COMMON /CiDEX / M , J , MU , MD, ISTaG 

COMMON /IXORIG/ LHO.LHEi LBOO^LBDE, LTOVlTEV LWOiLWE; LFOiLFEi 

• LOiLESTA, L'DUMfSI, 

• MOiNMi NjtNFCOLS* MAXNJ,mAXOL*MAXNM»MAXLEi 

• LEO.LEEi LROiLRB.LRD 

DIMENSION LIMITS(24) 

EQUIVALENCE <LlMITSiLHO) 

Common /sltab / wasS) ,X2U20 J Vslchnuzb) 

Integer sLchn 

COMMON /troubl/ err,errmaj,insrr,prerr 
logical err.errmaj, INSRR.PRERR 

C begin loop through station TaBLE 
LI ■ LO 


c 

c 

c 


lower boundary 
60 L2 « L1*LREXT<LII 
65 IF(L2.GE,LESTA) GO TO 100 

IF{NAmELB(L1J '•EQ.NAMEL8IL2) ) GO TO 70 
L2 = L2*lNeXTIl2) 

Go TO 65 
NAME agreement 

7D IF(FU0AT( iLBa2) )*rLB(L2) - FLOAT ( ILB ( U1 ) )bFLB ( Ll ) ) 80,85,100 
SWITCH points 
80 Ml 8 MlB(LI’) 


MLB<L2) 

I Lb (C l) 
FLBllil) 
siLaai) 

R(MlJ 


zsv It Z(Ml) 
lLB(Li)elLB(L2) 
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f^LB(Ll)BFLBtL2) 

SlLB(Ll)'=Sll.i(L2) 

R(M1) = R(M2J 
Z(M1) X 2(M2J 

lL0(L2>aISV 
P’LB(L2>aFSV 
S1lB(l2)sSSV 
R(M2> = RSV 
Z(M2> X zsV 
GO TO 100 

c coincident orthoqonals 

8t> Ml X 

^*AMBDY= NAMELB(Ll) 

Go TO 187 

0 UPPER Boundary 

100 L2 3 L1^LNEXT<L1) 

IF-(l2.GE;lESTa) go to 190 
IF(nAmEUB(L2) •Eo*nAmEuBI LI) ) GO TO 1^0 

U 2 X L2*LSeXT(L2) 

Go TO 165 

C NAME agreement 

170 IF(FL0AT( lUB(Ll) )*rU8(Ll) - FUOaT< I UB ( L 2 ) > .FUB ( L2 ) ) 180.l85il90 
0 SWITCH POINTS 

IbO Ml s MUBILl) 

M2 X muB(L2) 

ISV ■ lUBdl) 

FSV s FuB(Lil) 
ssv X siua^Li) 

RSV X R(M1) 

2SV X Z(M1J 
IU8(Li>xIuB(l42> 

Fuaai>:;FuB(L2) 

S1UB(l1)=S1UB(L2) 

R(M1) X R(m2) 

Z(Mi) 8 Z(M2) 

IU3(1-2)bIsv 
FU3<L2)=FSV 
S1U0(l2)xSSV 
R(M2) X RSV 
Z(M2) X ZSV 
GO TO 190 

c coincident orthogonals 

185 Ml a MUBtLl) 

nambdyx nambu^ilI) 

187 ERR X .true. 

write (6, 1187) Z<Ml)|R(Ml),NAflBOY 

c index LI 

190 LI X L1*LNEXT<L1> 

IFILI.LT.lESTA) go to 60 
RETURN 

1187 FQRmAT( 45H •#» ERROR « COINCIDBNT ORTHOGONALS AT POI NT , 2F lO 5 i IIH 
• along 8DY*,#6) 

End 
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fFF INJT# 


•DECK FFINIT 

SUBROUTINE FFlNlT 

•FFINIT initialization Of FAR FIELD CALC 

COMMON /CISBOT/ F ARFLD ( 2 ) »FRE6 C 2 ) i PRES t 2 > i RFF t NZP i 
1 IP(IO) iPPSdOJi AliA2i A0UM(6) 

integer FaRFLO,FREE;PBE8 

return 

END 
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n n oo r> o 


•deck FrFDNZ 

subroutine FUFDnZ 

CFRFDNZ generate ZDN, 


zij matrix for FaR-field bc; 


sFRFDNZ- 


station Table 
Index- LscOiLESta 

SCHOKEn station ChOKE INDICATOR ( AP JWF i BRHS • WR I OUT ) 
mcl s Sharp corner indicator (Budtbs) 

MCL = FIELB index of control streamline (PTM0VE»FL0BAL) 

Common /ChDATA/ XimiLNEXT(l)*MLB(l)iMuBa)»PRIM(l)* 

1 TVPELB(1),NaM|Lb(1)i II-B(1),FLB(1) ,SILB(A)i 

1 TyPEUB<D,NAMEUB<1)j IUBIl),FUB(l> ,SlUB<i)i 

5 VmB(1) ,DWDV(1J iX 2CLI1) iSUSWI (1) ,MCL(D • 

6 AnGTE(I) iPTTEtlj.PSTEd) tFGRTEd) iRGTEU) I 

& ANGExP(1),BSQEXP(475) 

dimension CRVL£<l),AN6LE(i> 

equivalence <SCHOKEiDWDV)»<CRVLE»ANgTE) * ( ANGLE.PTTE) 

integer PRIMiTYPElB;TVPEUBiSCHOkE(1> 

COMMON /ALLCOM/ M ACH A # PS A , TSA;PT A , TT A i AX I A VRG A , G AM A , 

1 MACHCiPSC,TSC,‘PTC#TTCi axic.rgc.gamc, 

2 daxit,scalea*tte.chotst 

REAL MACHA(l) iMACHC 

LOGICAL AXiAiAXiC 

LOGICAL CHOTST 

COMMON /ixortg/ lho.lhe, lboo.'lbde, lto.lte, lwo,lwe. lfo,lfe, 

• LOiLESTA, l0UM(8I, 

• MOiNMi NJ.NFCOLS# MAXN J, M AXOL . MAXNM i MAXLE i 

• LEO.lEE, LRO»LRi.LRD 

DIMENSION LIMITS(24J 

EQUIVALENCE tLlMITSiLUO) 

COMMON /ERAS82/ WSTAdOO ) ,DISP(100 ) ,WAKE(100 ) .TTIIOO ) ,PT<100 > i 

• LA^dOO) ,RGX(108> iC2CPXd00) ,DUM(534) , 

• INK25), IN2(29i2)i 

• NINT,M(21) ,EEf2l) iKK(21j ,XINT(2l) » 

• y1NT(21) ,ZZ(21) 

REAL M , KK 

dimension XI J(25,25) , YI J(25»25) 

Equivalence ^wsta.xi j> # (C 2CPX»YiJi 

COMMON /ERASE/ UNIT(25,25) 

COMMON /CPI / PIiDUMPKS) 

COMMON /CBITS / BITS, blank 

COMMON /CFRFLD/ NFF , M AXFF ,ZFF t 64 ) , RFF ( 64 ) , 

• ZDNf29 ) iDRDN(29> ,UDN{25) ,Z1J(25,25) 

dimension FQRXdOO) 

equivalence <fgrx,zij> 

Common /CFRFIn/ ATlNF,MlNF,RFrR8F,UINF,ZDNl,'ZDN25 

Real. mine- 

common /CPRINT/ PDUM(26) 

Common /cisaoT/ dumis<30j,adum(6) 
common /CPTM8V/ VELPOT, ICBB.'NODENSiCPTDUM 
common /CR / R(300) 

Equivalence #ri,'rffref> , (r25. adumiji) 
logical dsXze 
Real mi,m2,'b3,m4 
Data aki,ak2«ak3, ak4, ak9/ 

• 1,3662944,;096663443, , 039980924 037429637'; . 0145119621/ 
data BK1,BK2kBK3,BK4,Bk9/ 

• .5, ,12498594. ‘.06880 249, ,033283951 ,00441787/ 

Data aei, ae2kae3,aE4/ 

• , 44325141,”, 06260601, ,04757384,*,01736506/ 

Data 8E1.be2*bE3,bE4/ 
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Co 

C 

C 

C 

c 

c 

c 

c 

c 

c 


c 

c 


,24998368;; 0920018, , 04069698, 005264496/ 


JNputooo 

Mr Nr e 

ZDnIi ZDN25B 
'’rrREF 8 

0UTPUT#o« 
2 DN( 1 ^ 25 ) 8 
nj( 25 i 25 )« 


FREE stream MACH NUMBER , 

i-iMits or far field 
nomiNal Radius of faR fie^d : 


strbamwise 
z matrix 


PXTcN^.nW o » llNVtKSt 

EXTgiM&iON pRabTiON to ppa ADUMflJ 


COoORDINaTES for DN, far field SOLUTION 
(INVERSE OF ylJ)«xlJ* 


DZFF 

zdni * 

Zdn 25 = 
ZDn( 1)8 


lUl 


beta s SQRT^l;.MI^|F**2^ 

,°BETA a i;/aBTA 

initialize dzv zdn Table 

Incompressible plane 

NDENSvs NODENS 
NODENSe aj; 

ZdN25-2dNi 
ZDN l-ADUM( 1)»D2FF 

Z0N29*ADUM( 1) »dzff 
- zdnipobBta 

^DN(25)a ZDNaSftOBETA 
°Z a (ZDNf25);zDN<l))/24; 

Bo 2 K82.24 
ZDN(K), ZdN{M-1)*o2 

determine fF cross STREAM COORDINATE aT ZDN(25) 

L n LESTjJal9 

IF( LnEXT(L) •NE i20 > CALL ERRORi 
NA 8 ML8(L> 

mb a MubCL.) 

NK*"^ ^s^Jg;Jj^J'^^’'^'°^^^'”A'<EiTT,PT,LAM,RGX,C2CPX,FGRX) 

ISenTROPIc/ROceSS to undisturbed conditions at ZDN(25) 
“ 1 5» '8aMA»1 I ) 

® (QAM«-i;i/GAMA 

PT(NK)/(1,*Gm2*MINF*«2)8»H,/GM1) 

0 . 

0 

K*1 

(;:*FgRX(K) )/FGRX(K) 

1 ./(GMA«FQRx<K) ) 

(PS!Nf/PT{K) j8*GMt 
SQRTfC2ePX(K>«TT<K)*(i;;TSQTT>) 
PT(KJ/<RSX(KJ«TT(KM*TSqTT8«FGRX(K> 

d , rift •« 1112 


NK 

assume 

GM2 

GMI 

psinf 

area 

K 

K 

GMA 

GMl 

TSQTT 

V 2 

RH02 


a 

P 

a 

a 


1112 


I^.GT.i ) SO TO 
WQakMIb Rho 24 V 2 
QO TO 1111 

8 RH 02 #v 2 

* ArEA* 2 ;«<wSTA(K) 

WOaKMj^b wOA 

IPI *<;LT’,nK ) GO TO nil 

;25 a AREA*R(MAJ 

if! ^Xni- ’ I**5eSQRT(R(MA)8*2*ARBA/Pl) 
IF( iNOT.axIA ) GO TO 94 
NINT a 11 


WSTA(K#1| )/(WQAKMl*WOA) 


B INITIALIZE Parameters for integration 

3 DZZ S DZ/FL0AT(NINT-1) 

NOTE*aa8 RaDIAl CO-ORDINATE SC*LBD*»f*t# 
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DSING * O'.lnSfFRBF 
DSIZ^" B. .TBU8‘ 

IF( dzZ'le.osing ) dsizeb. false* 

FA B 4'.*RRFRBF«»2 

IF{ DSIZE ) DeLzDbDZZ-DSiNg 

DO ^ AMIMK D2Z,DS1NQ » 

« ALoat il25«DD ) 

SINGV s 2 >(-PUDD»AI)s,125»DD**3*U,*AL) 


C 

C 

C 

C 


OUTER LOOP FOR CaLC, OF XlJ.vU TABLES 
Do 90 1 aj. ,'25 

inner loop for calc, of XIJ.YIJ TABLES 
Do 89 J^l;25 

section to BUIlD tables for INTEQRATION 


tables are BUIlT in 2 PASSES 
KGO a 1 

IF( I.EQ.J ) GO TO 10 
*F( ‘J.EO.i ) KG0?2 
IF< J.EQ.25J KG0»3 
go TO 12 
10 •'gO a 4 


IF( J.EO.I > KG0*5 
IF( J.EQ.25) KG0Y8 
12 NIn 8 NINT 

IF( KqO'.Ne'.I '.and. XgO,Ne,4 ) N!N?<NINT-1)/2*1 
nmidso 

1F( KGO'.Eq'.A ) NM10=(NINTb1)/2*1 


initial Pass to build tables 

K 8 0 

15 K 8 K*1 

*<1 ' K-1 

C 8 

Go TO (20.29 y20,30,35,40) , KGO 


C normal BRanCH*-OR (J«25, r.NE.'J ) 

20 IF( K.GT.i ) GO TO 22 

21 ZZ(K) 8 ZDN<J)»i5«DZ 
GO TO 23 

22 ZZ(K) * ZZ{K1)*C»DZZ 

23 M(K) 8 FA/{FA*(ZDN( I )-ZZ(K) )»*2> 
GO TO 50 

C Jal, r,NEJ> 

2’ 1F{ K.GT.I ) GO TO 22 
2Z { •< ) 8 2dN( 1 ) 

GO TO 23 

C NORMAL singularity BRANCH 

30 IF< K.EQ.l » GO TO 21 

IF( ZZ(K;i) .NE.BITS ) GO TO 3l 
Kl 8 Kl2 

c * 2 : 

31 IF( K'.NE.nMID ) GO TO 22 

32 ZZ(K) 8 bits 
M(K> 8 Bits 
GO TO 50 

0 *«(l8j.jai) 

35 IF( K.GT;? > GO TO 22 
GO TO {32.36} , K 

36 ZZ(K) fL zdN(J>*DZZ 
GO TO 23 
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o n o o ri rj 


C *«{ I*J, J«?5) 

40 IF{ K.EQ.i > GO TO 21 

iF( k,eo;nin ) qo to 32 
Go TO 22 

t>0 IF( K.LT.min ) QQ TO 15 

C final pass to build tables...* A0JUST FOR SINGULARITIES CLOSER 
c than DZZ 

1F< ,N0 T. dSIZE » go To 70 
* 0 

55 K B K*1 

IF( ZZ(K) ;Ne',*8ITS ) qO TO 60 
Go TO (60.'60w6C,36,57.56) , KSO 

56 ZZ(K-1)» ZZ{K-1)*DELZD 

m<ks1)s ^A/{TA*{ZD^^( I )sZZ(k;i})*»2) 

IF( KG0:eq;6 ) GO TO 60 

57 ZZ(K*l)a ZZ(K*l)»DEtZD 

M<K*l)s FA/<SA*(ZDN(1 )sZZ(Kb1J)b*2) 

60 1F( K.LT.nIN ) GO TO 55 

c evaluate Elliptic integrals (k(m)iE(m>) 

70 Do 71 L» 1 ;NIN 

IF( M(L) ,^0;B1T9 ) GO TO 71 
Ml ¥ l.-H(Ll 

iF{ mi;eq;i: ;or. mi.eq.o. i call errori 

M2 s Mi«Ml 
M3 s M2«M1 
M4 « H2*M2 
TLOG s alOQ(1'./M1) 

evaluate KK 

KK(l’ * AK1*Ak2»M1*AK3»M2*AK4*M3*AK5*M4 
* *<BK1^8K2»M1*8K3«M2*BK4*M3*BK5«M4> *TL0G 

evaluate EE 


C 


EE(L) b 1;*AE1*M1*AE2»M2*AE3»83*AE4«M4 
« *( 0EltMl*BE2*^2*BE3*M3*BE4*H4) *TLOG 

71 Continue 


C calculate iNTEgRaNdS XlNT.ViNT 

do 73 Kbi.'nIN 

IF( ZZ^K) :eq;bITS ) GO TO 73 
den s S0RT(FA¥(ZDN(I )-ZI(K) 

XInT(K)b -4;4rT’FrEF«EE(K)/(0En*^zDN| I)-zZ(K) ) ) 
TinT(K>8 -2'.4<KKIK)-EE{K> >/DEM 
7>3 continue 

c integrate 


75 XIJI so; 

YIJI s o! 

K s 1 

76 K B K*1 

GO TO (77;77«77,78,78,78) , KSO 

77 Dzk s ZZ(K)-ZZIK*1) 
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^ERmX b 0;5«(XlNT(K)*XlN|TtKiin 
TERMY a 0,5«^YrNT<K)*yrNT(Kil} ) 

XIJI ■ XlJliTERMX*DZK 
Yiji i yiji?tErmy*dzk 
Go TO 80 
C 

78 IFC <ZZ(KrMB'.8lTS) ,AND, ( ZZ (Kil I , NE , 8 1 TS ) ) GO TO 77 
IF( KG0iE0,4 ) GO TO 80 

ir< KG0*EQ.4 ) K*K*2 

IF( t^GO’.EQ’.S > K*K*i 

GO TO 77 
C 

80 IF( K.lT'.nIN ) GO TO 76 
XIJ(I,J>3 XIJI 

IF( KgO*,GT‘, 3 ) YIJI*YU1*SINGV 
YlJd.Jis YlJi 

89 continue 

90 continue 

IF( PDUM(26r.*EQ;®. ) GO TQ 9l 
call TABprtOHXI J*X1 J»625*18> 
call TABPRT(3hY1 J, Y1J,625,18) 

91 continue 

c determine invepSe or yij 

call MATInvIYI J,25,UNIT,0,DET;IN1, IN2i29, ISCALE) 

DO 93 m;29 
do 93 Jbi;25 

ziJd.jiB o; 

DO 92 K«l/25 

92 Zun.jia ZIJ(I,J)*X|Jn,K)*UNlT(K,j) 

93 continue 

c transform back To compressible PL’ANE 

Go TO 97 

9^ call SETM(1,0. ,zIj,625) 
do 96 181,25 
DO 95 Jbi;29 
IF(I,eQ;j) QO'TO 95 
DXIJP * ZDN< I )»(ZDN< J)*,5«DZ) 

DXIJM s ZON( 1 ).(ZDN( J)-,5 «Dz) 

2i j( I , j)s ;i7/pi«alog<dxi jp/dXijm» 

95 continue 

96 continue 

97 call FMPYCd* BBT A , ZDN , ZDN , 25 J 
call FMPYCaK08ETA#Zl J,ZIJ.625) 

IF( PdUM(26)7eQ;0, ) GO TO ?00 
Call TABPRTI5HYI J^1,UNIT,625,10» 

CALL TA8PRt(8nZlJ,ZlJ,625,io) 

200 NODBNSs NDENSV 

WRITE <6,2U} ZDN1,R1,ZDN25;R25 

211 F0RMAT(//6X,l9H«BXTENDED EAR FIELD B0UNDARY«/7X, 2HZ«»F10. 3, 3x, 
• 2HR8 ,Fio*.3/7Xi2HZs,P10,3,3Xi2Hr«,Fio,3/) 

RETURN 

END 
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oncinonoono ncjonnoo 


«DECK ISBOT 

Subroutine iSbot 

• ISBOT* insert SPECIM BOUNOiKRV TYPES PlSBOTP 


COMBi 


STATAB, CHDATAk bdvtab 
station Table 

INDEX, L»L0,LESTA 

SCHOKEs station CHOKE INDICATOR ( ADJWF iBRHS*WRlOUT) 

mcl « sharr Corner indicator ^blDtbs) 

mcl * field Index of control streamljne (ptmove»flobal> 

Common /ChDATA/ Xl(l)iLNEXTfH»MLBa)iMUB(lWPRlM(l)i 

TYf*ELB(l)»NAMeLB(l)*lLB(l>,FLB(l)»SlLB(l) 
TYPEUB<O»NAMeU0U)«IUBIl) |FUB<1) iSlUB<i) 
VM 9 (l), 0 W 0 V(lJiX 2 CLn>iSLSWl(l>,MCL(l)i 
ANGTE<l)iPTTEfli.PSTE<l).FGRTE(l)iRGTE(l) 
ANGEXP<i).BSQ 8 XP{ 475 > 
dimension CRVLEU) iANeLE(l> 

equivalence (SCHOKEiDQDV).(CRVLBiANQTE)i‘( ANGLE.PTTE) 
integer RRlMiTYPELBVTtPBUBiSCHOKEd) 


1 

1 

& 

& 

& 


I 

I 


I 


BOUNDARY TaBLE 
Index, lbblbSo.lbde 
LBNEXTs increment to next boundary 

LBZl S increment to THE FIRST BOUNDARY POINT («0 BEFORE COALLATIO 
CHNaMep channel with WHIcH the boundary data is associated 
U p P T or F FOR UPPER OR LOWER BOUNDARY 

LEDEX » relative index of L'.E. point when lower and UPPER SURFACE 
CoNTBURS are connected 

BDNAMEiLBaVLBB«NAME and index limits or specific boundary 
dAja nhen Boundaries are cqAllated 
dimension BDT<1) iLBNEXTelliLBZl(l) • 

1 CHNAME(I) lUPd) VLEDEX(i) » 

2 ZBTd),RBTd).ANGBTf42) 


logical up 

integer BDTkCHnAME.BDNAME 

dimension BDNAME(I) #LBAel>.LBB(l) 


dimension 

integer 

equivalence 

X 

2 

6 


CHNAM<1) .LHNEXTdl 
CHNAM 

dliBDT.CHNAMj , (LNEXT ,L8NEXT .LHNEXT ) , (MLBiLBZt), 
IMJBiCHNAMEI* (pRIMiUP)t ITYPElBiLEDEX) • 
(NAMELB.ZBT.'BDNaHE) , ( iLBiRBT.LBA) I (FLBiANGbTi 
LBB) 


COMMON /IxORiG/ 

« 

» 


DIMENSION 

equivalence 


LHO.LHE, L8D0,LbDP, LTO.LTE; LwO.LwE. LFO.L^E, 
LOiLESTA, LDUM(8 »i 

MOiNM# NJiNPCOLS* MAXNJ , MAXOL » M AXNM i M AXLE » 
LEOiLEEi LROfLREtLRD 
LIMITS (24) 

(LiMiTSiLHO) 


COMMON /CFRFiN/ 

real 

COMMON /CIDEK / 
COMMON /CISBOT/ 

1 

INTEGER 

Common ^trouBl^ 

LOGICAL 


atinf,minf,rffref,uinf,Zdni;zdn25 

MINF 

H, JiMUiMDtlSTAG 

FaRFLD(2) ,FREfi(2) .PRES( 2) .RFF.NZP » 
ZPdO)iPPS(iO), A1 iA2iADUM(6> 

farfld,free;pres 

BRR.ERRMAJ, INERR.PRERR 
ERRiERRMAJ* iNgRRtPRERR 


logical ONce.SeTaG 
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O O CJ 


data KLE/ 2 HUE/, KtE/ 2 HtE/, KFIELD/SHFIElD/ 

data KFAR/6HFaRPLD/i KFREE/4HFRBE/| KPReS/4WPRES/ , KS0L1D/5HS0LID/ 
data ONCE/’.PAlSE./ 


c check pOR incorrect channel input names 

LH » LHO 
GO TO 43 

C LOOP THROUGH BOUNDARY TABLE TO SEE IF CHNAMtLH) IS REFERENCED 
32 LB B lBDO 

35 IP(CHNaM(LH)7eQ;ChNAME(LB> *.0R; CHNAM(UH),EO.CHNAMEaB + l)>GO TO 40 
LB ^ ^B*L8nEXT|L9) 

IP(LB.LT.lBDE) go to 35 
c NO Reference found for chnaN{Lh> 

ERR i -.true: 

write (6.103S) CHNAM(LH) 

1035 F0RMAt(57H *»» ERROR « BOUNDARY INPUT DATA DOES NOT REFERENCE CHN 
1»«A6) 

C INDE^ TO nE^T channel 
^ 0 LH s L«*I-HNEXTILM) 

45 IF(LH.LT.lHE} go to 32 


LOOP Through btation table to insert special boundary types 

L = LO 


lower boundary 
100 NaMB a NAMELB(L* 

KTYPE s TYPELB(L) 

ITVL p iLBOi) 

IRET a 0 
So TO 500 

150 TvPeLb<L)bKTYPE 

IF <ktype,ne;hsolid> namelb<l>»namb 


UPPER BOUNDARY 
NaMB 3 NAMEUB(L> 
KtypE X TYPEuB(L) 
ITVL a luB(U) 

IrET a 1 
GO TO 500 

250 TvpeUB(L)8KTYPE 

if(ktype;ne‘,hsolid) 


NAMEuB(L)*NAMB 


C index to next station 
L « L*LNEXTa) 
IF(L,LT;lESTA) go to 100 

return 


•• general logic for either upper or lower boundary 

NAHB 8 BOUNBARY NAME 

•<TYPE p Boundary. type 

500 IF(KTyPE.EQ.KLE .or. KTYPE'.EQVKTE iORi KTYPE, EQ.KFIELD) 
a GO to 599 


CHECK boundary TaBlE TO Find segment name if TYpEaSOLiD, 
SETAG a ;rACSE'. 

Lb 3 L8F(BAM8> 

NAmBD a tgAM? 

IFIKTyPE.nE.KSOLID) go to 520 
^BXN B Lsziaei 
inLBXN'.Eo’.O} GO TO 520 
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^ f-BX c L8Z1^LB)*3*ITVL-3 

c lbx = Index (relative to subtable origin) of the 

c interval of the ol-boundary INTbRSECTION point 

LBl B lb 

510 IF(lBA(LBi) ’.LE'.lBx .And. LBB(LBi) .QE.LBx) go to 515 

a LniaS 

lF(LBi;LT.(Li*LaZl(LB))) GO TO 510 
CALL ERRORl 

C CHECK FOR FIRST OF DOUBLE POINTS ON UPPER BOUNDARY 

515 IF(IRET'.E970 .or, LBX,NE;lBB(LB 1) ,0R. (LBl*3) ,GE, (LB*LBZ1(LB) ) 

» .OR, LBA(U81*3),NE,(LBB(LB1)*3)) GO TO 518 
C change StATlON*TABLE REFERENCB TO THE 2ND PT <1ST STREAMWISE PT) 

NaHBD = BDNAHE(lBI) 

LBl s L91*3 
IuB(L ) 8lu0(L 1*1 
SETAG a *,T(ilUE. 

518 NamB a BDNAME(LBI) 

C determine if ilVEN BOUNDARY NAME HaS BEEN SPECIFIED BY 
C USER INPUT AS A SPECIAL BOUNDARY TYPE 

520 IF(NAmB|Eq|FArFlD(1) , OR , NAMB'.BQ ,FARFLD( 2 ) ) KTYPEaKFAR 
IF(NAmB,EQ,F*EE(1) ,0R, NAMB.EQ*,FREE(2) ) KTVPEaKFREE 
IF(NAMb;eq;p»eS(1) ;0R, NAMB.eQ’.PRES(2>) KTYPEbKPReS 

C set ISTAG EQUAL TO ZERO AT THE SOLID/FREE BREAK POINT 

IF( ,N0T;SETAG ;oR, (NAMBD.NE.FREE<1) ,AND, NAMBD,NE,FREE(2) .and, 

• NAmBD.nE’.PRES(I) ,AND, NAMBD’.NE,PRES(2) ) ) GO TO 530 
M ® MUB(L) 
call GETIx 

ISTAG a 0 

Call savix 

C FAR..FIELD BOUSdARY GEOMETRIC DATa 

530 IF(kTyPE.nE‘.KFAR .OR, ONCE) GO TO 599 
LBl s LB*L8Z1(LB> 

Lb 2 a Lb*L8NEXT(LB)«9 
RFFREF= RBT<UB2) 

ZONl = ZbT(Ub2) 

ZDN25 a ZBT(LBl) 

write (6;i530) RFFR6F,2DNi,7DN25,NaMb 
1530 F0RMAT(//2X,4iHTHE FAR FIELD INTERFACE BOUNDARY IS AT Ri»,F9.3j 
»iiH Between Zb.f9,3iAh and.f973';ih,,8h (Bdy*. a6,ih> > 

c SET UP FAR field SOLUTION MATRIX 

CALL FRFDN^ 

Once a .iRUEi 

c return 

59V IF(IRET) 150^150,250 
End 
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n n n o o no nonono non 


•DECK DUPl 

Subroutine lfit2d(x, y.toiNxv) 

•1,FIT2D LIMEAR surface interpolation *»LFIT2D* 

c !N A rectangular GRID 

dimension X(2),Y<2),Tb(2> 

INPUT" 

x*Y a list of coordinates at which interpolated values are to be 
NXY a NO OF coordinate POINTS 

NXT 8 NUMBER OF XT ‘ 

NVT a number of YT 

XT 8 X-GRID OF T-TABLE 

YT 8 y-grid of t-table 

Y 8 table of values 

note s number of T-VALUES is nxt«nyt» order is illustrated below 


YT(NYT)P 

T(S) 

T(6) 

T(nXT*nYT> 

YT(2) • 

T(2) 

T{5) 

T(8) 

YY(1) • 

Till 

T ( 4 ) 

T(7) 


XT(1) 

XTI2) 

XTINXT) 


output. 

Yo 8 interpolated values at x.y 

common /CTHICK/ NXT,NYT,XT(20* •YT<20>iT(78) 
Common /Erase / DuM(4oo)iTK2flOi.T2(2oo) 

c find correct X«INTERVAL 
1=1 
M s 1 • 

ISV * 0 

100 NC0UNT8 0 

105 IF(X(M) •LT'XTI I ) ) GO TO 1$0 
1P(X(M> .GT'.XTi 1*1) ) GO TO 120 
F " (X(Ml-XT(I>)/<XT(I*i).Xt(l)> 

Go TO l^o 

110 *F(I,EQ;1) Go TO 140 
I 8 i;i 

GO TO 125 

li!0 IF( { 1*1) ;qe;NXT) QO to 145 
1 = 1*1 

125 NcOuNjs NcOuNT*! 

IF(NC0UNT’.GT7NXT) call errori 
G o TO IO5 
140 F a 0*. 

Go TO 150 
145 F e 1; 

c interpolate WRT Y 
150 1F<I,EQ;ISV) go to 160 
Ij2 8 i«NYT*1 

IJl 8 IJ2-NYT 

Call lfItiiyt.ti U i) iNyt, y;ti,nxy) 

Call lfiti« yt.ti ij2 J ,nyt, y;t2iNXy> 

ISV B I , 

c Interpolate mrt x 

160 T0(M) 8 F*t2^M)*(1|*F)*T11M) 

M =.M*l 

lF(MiLE*NXY) GO TO 100 
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c,,, end Loop for interpolatIong to<m> at x<m) ,y(M),m«i.nxy 

return 

End 
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•DECK DUP2 

subroutine TTpTIMAiHBi WSTA;D1SP,WAKEiTT,PT,LAM.RGX,C2CPX,FGRX) 

•ttpt-«» tt» pt, and rcu roR streamlines pttpt* 

logical wake 

REAL LAM(25) 

dimension W8tA(25> •0ISP(25)*TT^25)»PT(25> » 

1 R®X(25),C2CPX(25i.FGRX<25) 


INPUT- 

ma s first field point 

mb b last field point 

OUTPUT, 

WSTA s list of stream FUNCTION VALUES 

DISP(K)?N0N-2ER0 FOR POSSIBLE SL'IP CONDITION BETWEEN STREAMLINE 
K AND K*l, OTHERWISE DISP(K)80. 

B displacement thickness of Wake if positive 
Wake b .true; if there exists any wake displacements, 
tt b interpolated total temperature 

PT « interpolated total pressure 

lambdas lamina thickness in third DIMENSION! BLOCKAGE EFFECT 
RCU s Interpolated angular momentum •••not now in use 

RGx a GAS Constant 
C2CPX 3 SPECIFIC heat 

FqRX 8 i;/(GaM- 1 ,)s function Or gamma for calculating density 
note - length of wsta,tt,pt;rcu;lists is MB-MA*1 

WAKETB, CONVTBw CaDjWF 

table of CONVEcTED properties 
index- LTsLTO.LTE 

Common /CHDATA/ CH(l)iLTNEXT(l)*NPm>iLPSItl)»LTTm,LPT(lT; 

1 LRCUm, 

2 CRG(l) ,CPGjaJ,C2CPIl> ,0QAM(1),FGT(1>,F0P(1», 

^ FQR<1)iAREATB(A85> 

integer ch 
Dimension xchcD 
Equivalence (ch.xch) 

SEE other listing OF TTPT FOR EXPLANATION OF VARIABLES 
FLOW adjustment TABLE 
INDEX, LFbLFO.LFE 

Dimension xiF(d !X2F(i) iXiBFti) ixiaF(i) i 

1 Sira),NcHB(l)iNCHAa)|JORDER(l>iVNR(i2I 

equivalence aFB,XlBF», (LF a;X1AF)| (LRF,NCHB>i (LRXF.NCHa) 

DIMENSION LFB<1) iLrA(l)«LRF<l>#LRXF(l> 

table of WaKE displacement thickness 

INDEX, LWbLWQ.LWE 

dimension X2B(1) .LWNEXT(I) ,s1W( A7) 

dimension DsTU) 

equivalence tDSTjSlW) 

subtable arrangement is- 

X2WiLWNEXT(«2*2N)i SlW ( U . S1W(2 ) . . .SlW(N) ( DST(1 ) i DST(2 ) i . DST (N ) 

X2W S streamline coordinate 

Siw B distance along streamline from t*.E, 

DST B wake displacement THICKNESS AS A FUNCTION OF SIW 
EQUIVALENCE ( CH , XlF , X2W ) , ( L’TNEXT , X2F i LWNEXT > , ( NPT , XIBFISIW ) 

EQU valence (LPSIiXlAF). «LTTiSlF)i (UPT.NCHB>i (LRCUiNCHA) 
EQuWaLeNCE (CRG,J0RDER). (CPGJiVNR) 

COMMON /IXORIG/ LHO.LHEi LBOO.LBDEi LTOVlTEV LW0,LHE, LFOiLFE* 

* LOiLESTA, L0UMj8)i 

• MQiNMt NJ,NFC0LS» MAXNJ,MAXOL»MAXNMiHAXLEi 
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LEOiLEEi LR0*L"RE*LRD 
DIMENSION LIM1TS(24I 

equivalence (LIMITSiLHO) 

Common /slTAB / wtiaS) »X2(128} »6LCHNa28) 


integer SLcHN 


COMMON 

Common 

COMMON 

COMMON 

COMMON 

Common 


/CIDEX / 
/'CMAXiT'' 
/CPtMOV/ 
/CR / 
/CSl / 
/CTHICK/ 


M, J.MU.MDtlSTAG 
MAXtTiMAjCTR»aReriNiEDUM 
VELPOT, ICOBVNODENSiCPTDUM 
R(300) 

Sl<300) 

NTHKXiNTHKY ,THKJ({20) ,THKY(20) ,THIK2D(78J 


Common /cz / Z(300) 
common /erase / PSK800 ) 


integer chx 

C interpolate for lamina THICKNESS 

NK = M0iMA*l 

Call setm(1,i;. lam.nkj 
IF(NTMKX;l'E*1) go to 100 

call LrlT2D(2(MA),R<^lA),LAM;NK) 


c initialize 

100 WAKE a .rALSE'. 

C DEFINE number OF STREAMLINES,' Nk, ASSOCIATED WITH EACH CHANNEL 

K » 1 

M a mA 

WADD a 0. 

105 nk a 0 

*^1 a K 

Mj. t M 

110 CaI-L Ogjly 

iFlM.NEiMl) 60 TO 114 
Chx a SLCHN(J) 

PSll a X2(jl 

114 Ip{SL.cHN( J)',Re’.CHX) QO TO 120 
NK a NK*1 

dispiki^o’. 

WSTA(k)«W( J)?WADD 

PSi (NK)3X2( JJ 

a K*1 
M a M*1 

IF(M,LE;Mb) 60 TO 110 

c find Index in convtb 

120 LT a lTO 

125 IF(LT.GT,lTE) call ERRORl 
IF(CH(LT) ’.EQ7 cHX) go to 130 
Lt a Lt*LTNExT(LT> 

Go to 125 

c interpolate for convected properties 

c Scale the psi table to conform to the lpsutable in /convtb/ 

130 NI a NPT(LT) 

I s LT*L»S1 (LT) 

I2 a UNl 

’f(Ki;eq;i ;and. nk;eq,d psiiaPsU*8, 

PSIl a 8'.*AInT(PSII/8, ) 

F a XCHCI2-1)/8, 

Do 140 KNaliNK 
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140 PSJ fKN)ji{PSHKN);PSH)*F 
IT B LT^UTTd'T) 

IP ■ LT*U'RT<|.T) 

Is f LT*LRCU(LT) 

Call LSPFiT{CH(n,CH(iT),Ni; psi.ttjkd.nk, o) 
CALL LSPFiTteHd ),CH(IP),Ni; PSf ,PT (Kl) ,NK, 0> 

CALL LSPrrt(eH(i),CHns),Ni; psi .rcu(kij ,nk. O) 

call SETM(1iCrG(LT)iRGX(K1).NK> 
call SETM('i,C2CP(LT),C2CPX<K1),NK) 

Call SETM(l,FQRtLT) ,FGRX<Kl).NKi 


c 

c 


c 


c 

c 


155 


170 

175 


180 


164 

166 


i^AKE displacement thickness 
Search for xa-suBTABLE 
IF(M,GT‘.MB) 80 TO 200 
» X2(Jl 
dISP(K,i,.;i7 
UW 3 LWO 

IF(LW,GE;l'WEJ go to 190 
IF(X2W(LW) *.Eq;X 2J) GO TO 1^0 
Lw s Lu*LWNEXT(LW) 

Go TO 155 

find TRAIlIN* edge si in the flow adjustment table# sir 

LF 8 LFp 

IF(X2F(LF) .EQ'.X2J) GO TO 188 
LF 8 LF*NfcOlS 

IFILF.lt, LFS l GO TO 175 
call ERRORI 

interpolate for waKe displacement thickness; DSTaR 
SIFTEsSKmJ-SIFILF) 

si-from;t:e? 

iFlSlFTEiLEiOi ) GO TO 190 
N * (LWNExT(LW)«2)/2 

LSTaR b Lm^N 

CALL LSPFlt<SlW{LW),DST<LSTARJiN. SlFTE,DISP(K-l» ,1, 0> 

IF(DIsP<K.1)| 184,184,186 

DlSP(KBl)ail7 

GO TO 190 

WAKE a :tRUE; 


C LOOP FOR next channel 
190 WadD 8 WStAtK*l> 

GO TO 105 

C USE constant fiENSlTY APPROXIMATION FOR MA JCTR LE , NODENS 
200 IF(MAJCTr;lE 7N0 DENS) call SETH<i,OMFGRX.KBl) 

return 

End 
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•DECK Builds 

0VERLAY(STCi1,3) 

Program builds 

Plow adjustment table 
Index, lfslfo.lfe 

LQMMON /ChDAtA/ XlF(l)»X2r(l)»XiBr(i)iXlAF(i)i 

1 SlF(l) ,N chB(1>,NCHA(1) , JORDER(I) ,VNR(i2) 

equivalence (LFB,X1BF) , (LFAVXIAF) , (LRF.NCHb) , (LRXF.NCHa? 

dimension LFB(D .LFA(1)*LRF(1) .LRXF(I) 

dimension TAbLeS<10) 

EQUIVALENCE < TABLES 1 1 ), XIF ( 1) ) 

dommon /clwosv/ lwosv 

Common ^ixorig^ lho.lhei lbdo.lbde, lto.lte. lwo.lwe, lfo.lfe^ 

* LOiLESTA, lDUM<0), 

" MOiNM* NJ.NFCOLSi MAXN J, MAXOL . MAXNMi MAX lE i 

* LFOiLEEi lro#lre»lrd 
dimension LIMITS(24) 
equivalence (LIMITS»LH0) 

COMMON /select/ LENTRY 

Go TC (5.10U LENTRY 

^ Call bldtbs 
Go to 20 

pebuild convected properties Table and repack if restrtbt. 
in call rbcqnv 

^MOvFls LTE-LBD0*1 
LWTO s LHE*1 *NmOVE1 

Call M0VE(2, TABLES(LBDO),TABLESaHE*l) ,NM0VE1.1| 

1 TABLES! LWO) •TABLES(LWTO)iLESTA-LWOSV*lH> 

f^OVEl s LHE*1.L8D0 
LBDO s LBDOtMOvEl 
LBDE = LBOEtMOVEl 
LTO = lTO*MOVE1 

LTE s LTE*M0VE1 

LWO e lwTO 

move2 = lwo-lwosv 

LWE s LWE*M0VE2 

l-FO 8 Lr0*«0VE2 

CFe S lFE*M0VE2 

LO s LO*MOVE2 

LESTA X LESTA*M0VE2 

SET FLOW adjustment ITERATION COUNTER TO ZERO 
EF = LFO 

ifilf.ge.lfe} Go to 20 

VNR(LF)s o’. 

Lf s lf*nfcOls 
GO TO 850 

20 Return 
end 
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•DECK BCONV 

Subroutine bconv(chtaiLTAiArea) 

•BCONV" BUILD CONVECTED PROPERTIES TABLE PBCONV* 

integer CHTA 

JNPUT- 

CHTA 8 channel NaHE 

AREA 8 PLOW ARBA in CASE NO ^CHDATA^ IS AVAILABLE 

Data in the channel data tablei /chdata/ 
output- 

lta a index or chta in convtb 
SUBTABL: OF convecteo FLQN properties 
Determination op channel flow rate 

output roR faR field calculation 
ATINF b speed or sound at stagnation temperature 
mine b free stream MACH NUMBER 
uinf 8 Free stream velocitv 


c 


CHDaTAi convTb 
channel input data table 

INDEX- LHaLHOiLWE 

table or convEcted properties 
Index; LTaLTO.LTE 
CH a ChANNELNAmE 

LTNEXTs index increment to the next channel 
LPSI 8 relative location of PS! LIST 

MPT S NO* or PSIl TT# PT AND rCu VALUBS 

LTT «: relative location of TT LIST 

LPT P relative location of PT LIST 

LRCU a relative location of RCU LIST 

Common /ChOATA/ GHNAM<l)iLHNEXTa)»WTrLOW(l)»TTO(l)iPTOa) • 

1 tso<i),pso(i);macho(1),aO(x>,vaRv<i). 

2 RGU).GAM<1). NR(1)|NC(i),TAB(6)» 

A BB(79) 

logical vary 

integer CHNAm 
dimension V0(U 

real macho 

EQUIVALENCE IVOiMACHO) 

Dimension ch<ij »LTNE xT<f) •NPT(i)iLPSi(iiiLTT<i)*LPT<iJ* 

1 LrcU(1), 

2 CRGa),CPGJ(l),C2CP*l),QQAM«l),FGT(l),FQP(lf; 

3 FGR(1),AREATB(485» 

integer CH 
dimension XCHd) 
equivalence ICHiXCH) 

EQUIVALENCE ( CHNAM * CH ) i < LHNEXT i LTNEXT )»( WTFLOW »NPT > • 

& (TTO*LPSn»<PTO*LTT>* (TSO'LPt)' (PSO'LRCUM 

& (MACR0,CRe),(AQ,cpGJ).jIVARV,C2CP), 

& (RG,QGAM),<GAM»FQT), INR,rGP).'<NC.rGR), 

A (TaBiAREATB) 

COMMON /ALLCOM/ MACHA,PSA,TSA*PTA,TTAi AXIA/RGAi GAMA, 

1 MACHC,PSC,TSC;PtC,TTCi AX I C , RGC i GAMC , 

2 daxit,scalea,tte.chotst 

REAL MACHA( 1) »HACHC 

LOGICAL AXI Ai A xICiChOTST 

Common /ixorIg/ lhOiLHe. lboo;lbdEi lto.lte.' lho»lwe* lfoilpei 
• LO.LEsta, LDuM(8)i 

4 MO.NMi NJ.NfCOLS, MAXNUVMAXOL.MAXNM.MAXLE, 
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ft 


DIMENSION 

EQUIVALENCE 

COMMON /CBITS / 
COMMON /crRFlN^ 
REAL 

COMMON /CGRAV / 

Common / cnoRm 
Common >'cpi f 

COMMON ^'CQlREM/ 

Common /ctapos/ 
logical 

^Common /erase/ 

dimension 

equivalence 

COMMON /TROUfiL/ 
LOGICAL 

integer 

Data ext/3HEj<t/ 


LEOiLEEi LROtLREiLRD 
LI HITS (24) 

<LlMITSiL«0) 

BITS, blank 

ATINr,MrNR,RrrRir,UINF,ZDNl.ZDN25 

MlNP 

CG 

/ rhliRm, ahl;ahm 
PI iTWOPI ,pra2;pi04,T0DEQ,T0RAD 

YTOL, yo,dydk»ctrmax 
RESTRT,ENDB0T;ENDFIL,K6sV 

restrt,endbbt;endfil 

E0UmI72»,QV<8J, A<90>,V<90); 

PSI<90),P(90);tT{90),PT(90>.RCU{90),PS(90> 

Y(90) 

(Y,R) 

err.errmaj, inerr.prerr 

ERR.ERRMAJ, INERR.PRERR 
ChT.EXT 


CHT ? CwtA 

CALL SETM(1,BITS, PSI.540) 
Call rtcfkcht.lh) 


c 


DEFINE GAS PROPERTIES 
LT s LTE*1 

LTE s LTE*15 

QGAM(LT)so; 

FGR(LT)so'. 

fgp(lt)si; 

FGT(LT)»i. 

Gamma s gama 

IF(LH.NE,o ;and. GAMILHJ .NE'.BIT: 
If (GAMMA, EQ, e, ) GO TO 85 
FGi 6 GaMMa.i; 

FGR<LT)»i:/FG1 

FGP(LT)»GAMMAftFQR(LT) 

f’GTILTIsFGl/fiAMMA 

QGaM(lt)si;/«amma 


GAMMA»GAM(LH) 


B 5 Crg(LT) 3 Rga 

IF(LH.NE.o ;AND; RG(LH) .NE’.BITSJ CRG(LT)sRg<LH) 
CPGJ(LT)=FGPfLT)*CRG(LT) 

C2CP(lT)«2.p6pGJ(LT) 

define total properties as determined from data ON 
STC/SHEET^l OF INPUT 
TTC B ttA 

PTC B pjA 
PSC fi.PSf 

1F(GAmAiEQ. oV) GO TO 95 
PG2 3 GAMA*i; 

PGRA P GAMA/FG2 
Go TO 97 

Fg2 b 1;/(TSA»RGAJ 
^GRA 3 

97 IF(MacHa;eQ;BITS) GO TO 99 
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TTQTS s l',*',9»rG2«HACHA«MACHA 

TTC e TSA#TTQTS 

PTC 8 psa*ttqts»»fgra 

TSC 8 tsA 

GO TO 100 

99 TSC s TTC«(PSC/PTC)*«(l,/rGRA) 

TTQTS 8 TTC/TSC 

machc s sort{ 2 ;»(ttqts.i, )/ rG 2 ) 

C number op input streamlines; aiVEN FLOW rate, 

100 NSL S 1 

wtf p o'. 

^p(Lh;eq;o) ®o to iso 
NSL p nr<lh> 

iPCWTFLOWdWr.NElBlTS) WTF-WTFL0W<UH)/CQ 


C NO input profiles 

1P(NSl,NE',0) go TO 150 
TT 8 ttC 

PT s PTP 

IP(TTO(LH) .NB'.BiTS) TTbTTOILH) 
IP(PT0(LH) .NB'.BiTS) PTpPTOILHJ 
NSL 8 1 


PILL PS, pt; tt and rcu Tables 
150 IP(TT,EQ;bITS) TTbTTC 
IP(PT.EQ,plTB) pTpPTC 
JPIRCuIEq.BITS) RCU=Oi 
IP<PSI;eq;b*TS) go to 160 
Call pillipsIiPTiIinsl) 

CALL P1LL(PSI;TTi1iNSL) ' 
call PILL(P 8 r*RCUiliNSL> 
^P(WTf;eQ'.o; J go to 2 S 0 
CONST 8 WTF/PSHNSlI 
Co i55 JbiVnSL 
155 Psl(j)a CONST«PsI(J> 

Go TO 250 


160 IP{R,eQ;biTS} go to 190 

Call pillir^rt.i.nsl) 
call PILL{R*TTi1iNSL) 
call Fn.L<R,'RcU,l,NSL) 
lPlPS;NE.alTS> call PILL<R,PSaVNSL> 

c integration Of RnQ*V«DA 

1P(NSl;Eq',1) go to 190 
IP(PS.EQ;b!T9 ’.and, wtp.eq.o.j call errori 
‘P(AX‘A) go to 170 
DO 1.65 JsiVnSL 
165 ACJ) B Yfj) 

Go TO 173 

170 DO 172 JbiVNSl 

172 A(J) a P 1 #R{J)»R<J) 

173 PTMIN b PT(1) 

DO 174 JbbVNBl 

PTmIN 8 , AMJN1(PTMIN,PT(J)) 

1'4 1P( A( J) iLT. AU-l) ) ERRs.TRUEi 
IP(ERR) GO to 182 


175 Qv 8 o'. 

176 iP(pS;Eo;ei^S) qq Tq 177 
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YTOL S 1:E4 

Go TO 179 

177 B ,95*P'''MIN 

, TTQL ” WTF*l'.E-5 

170 Call setm(1,rs. ps(2> ,nsli*i> 

179 Do ^8o JsliNSL 

■''S B TT( JJ»(PS( j)/PT(j) )**FGt(LT> 
lF(TS;GB;Tt( J) ) GO TO 185 

V(J>. 5 SQRT^C2CP(LT)^*(TT< J)-TS))‘*PS(J>/(CRQ(LT)«TS) 

180 CONTINUE 

psMi)* o; 

CALL LSPFltU. V.NSLi A.PSI.nSL. -1> 

DELP * PTM|M-PS<1> 

XJP 8 ,?«DElP 

DyOx 8 (NSL)/DELP 

TO 3 WTF 

Call qirem(ps,psknsl),xjp,qvj • 

IF(QV,QE;2*. 7aND. QV<5) ,eq;0, » eo to 183 
IF(QV.EQ.21'. J GO TO 104 
IF<QV.Ne;o*. ) GO TO 178 

c ttMACHC AND TSC FOR FAR FIELD CALCULATION (RARE OPTION) 

MACHC 8 V(N8L )/SQRT(GAMMA»CRQ(LTI*TS) 

TSC a TS 
Go TO 250 

C ERROR comments 

182 write (6. 1181) CHT 
GO TO 107 

183 PSIMaxb PSI(NSL)«cO 

WRITE (6;i188) CHTiWTFLOW(LH).PSIMAX 
Go TO 186 

184 write (6.1184) WTF, CHT 
GO TO 106 

185 WRITE (6,1185) CHT 

186 Call TA0PRT(8HQV,QV,8,8) 

CALL TABPRT (6HC0IREM, YTOLt^*^) 

CALL TABPRT(3hPSI ,PSI »NSL»10) 

187 ERR B .true'. 

Call tabprtijhps.ps.nsliIO) 
call TABPRT(2hPT,PT,NSL,10) 
call TABprT(8HTTiTT,NSLi10) 
call TABPRTIAHAREA, A,NSL,10) 

Go TO 250 

c given MACH NUMBER, AREA AND STATIC FLOW PROPERTIES 

190 lF(WTF,NE’.Oi '.AND, (LH,EQ,0 ,0R*. MACHO ( lH ), EO ,B 1 TS ) ) GO TO 200 
MACHC 3 mACHA 
IF(LH.EQ.O) So to 195 

IF(MACH0(LH)7nE;BITS) MACbC.MACHO(LH) 

1F(PS0(LH) ;NE;BITS) PSC»PS0(LH) 

IF(TSO(LH).nB.Bits) TSCbtsO(LH) 

195 IF(qGAM(LT)’,Eq’« 0. ) FGlsl , / { ySCfCRG ( LT ) ) 

TTQTS b i;*075«P61»MACHC*MACHC 

196 IFCLHiEQ.O 70R. ( TTO ( LH ) . EO , B I tS ,AND, PT0( LH ) ; EQ B I TS ) ) GOTO 197 

c »total Conditions are specified rather than static 

TSC a TT/TTOTS 

RSC s pT/TTQTS«»rGP{LT) 

Go to 198 

197 TT b TSCaTTQTS 

PT s PsCttTTQTS«»FGP(LT) 
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lya |f(wtf;ne;p; J eo to z^o 

[F ( LH.NE. 0 .and, AO(LH).nE.B!TS ) AREA*AOaH)«RHU 
'F ( LH.ne; 0 iANn, AOaHj'.NE. bits ,AND’. AXIA > AREA = AO<UH?#Pl 
« oRHL*»2 

AREATr(uT)«AHeA 

WTF 3 PSC/^CRG(LT )*TSC)«ArEA*mACHC 
1F(qGaM(LT);NE;o. ) WTFaWTF«SQRT(GAMHA»CRG(LT)«TSC> 

GO TO 240 

' GIVEN FLOW rate ♦ TOTAL/STATiC CONDITIONS FROM STC/SHEET<*1 
200 AR£aTR(LT )*0'; 
iFdSC.LTiTTC) 

,/^?^^^S^'-^>='^^^‘*CRG(LT)«TSC/(PSC«S0RT(C2cP(LT)*(TTC.TSC))) 

210 area s aREATB(LT) 

240 PSI(NsUswTF 

if(wtf,ne;o; j go to 25o 
ERR a .true. 

WRITE (6,1200) CHT 

' PUT DATA IN CONVTB-ARRAY 
CH(LT)s CHT 

NPT(LT)snsl 

^T1 3 LT*15 

Call moveci, psi ,ch(Ltd ,nsl,i) 

LPSI (LT)slTI.LT 
LTl 8 LT1*NSL 

Call move(i, tt;ch(ltd .nsl.ij 

LTT<LT)»LT1*LT 
LTl 8 LT1*NSL 

Call mov6(i* ptiCh(lti) insl*U 

LPT ( LT ) rLTlxLT 
L^l =L^1*NSL 

CALL MOVEd, RCU.CH(LTI) ,NSL»1) 

LRCU(LT J=lT1-LT 
LTMEXTlLTjalS^AttNSL 
LTE s LT*LTNEXT<LT)-1 

external channel properties for far field calc 

IF(CHT.NE;EXT) go to 990 
ATINF s i.E6 

IF { gamma. NE; O'. ) ATINF8SQRT{GAftMA*CRG(LT)*TT(NSL)) 

MINF « MACHC 

UlNF = MACHC*S0RT<GAMMA3CRG<LTi*TSC) 

990 LTA B lT 

return 

lltt5 FORMAT! ^1 x20h»*« ERROR- FOR CHnsA6, 1x53hTHE STATIC PRESSURE EXCEE 

‘»Ds the Input total pressure'. »8H|Bconv) > 

1162 FORmAT(3ah ••• ERROR- ThE R (OR Y) fOR CHNs ,A6i 
•JSH MUST BE In ascending ORDER (8C0NV> ) 

1103 F0RMAT(2iH «#o Error- for CHNs iA6i31H the input flow rate of 
• WTflOWs,F9‘.3k 37H iS QReaTER ThaN THE CHOKED VALUE OF ,F6,3, 

(BCONV) j 

1184 FormAT( 53H »«* ERROR- FAILURE OF PS-ITERATlON GIVEN WTFLOW/CG=j 
«F9,4, 9H FOR CHN$ ,A6,8H (BCONV) ) 

1200 F0RMAT(/ix 32HERR0R. THE FLOW RATE FOR CHANNEL2X, A6, iXiSHlS NOT DEF 
«lNEDi ) 
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•DECK BlDTBS 

SUBROUTINE 
•blutbs 

C 


_ bldtbs 
ruild orthogonal-'channel Table, 
streamline table, station table, 
field tables and flow adjustment table*. 


PBLDTbS* 


c input- 

c boundary TABLEi /BDYTAB/ 

c channel input date, /CHDATA/ 

C ORDERED EDGE POINTS, /LETEPT/ 

c output- 

C LIST OF CHANNELS FOR EACH ORTHOQONALi /ORTCHN/ 

c Table of convected properties? /convtb/ 

c streamline table* /SlTAB/ 

c STATION table. /STATAS/ 

c FIELD values^ /CZ/, /CR/, /CSf/,* /CM/ 
c Table of stas at which flow adjustment must 
c trailing edge wake displacement thickness 


be accomplished, /cadj 

TABLE, IF NOT CARD INPUT 


C COMALL 

c channel input data table 

C INDEX, LHsLHO.LHE 


niMENSlON 

1 

2 

4 

LOGICAL 
integer CHNAM 
DIMENSION 
real 

EQUIVALENCE 

boundary table 

INDEX- LBaLBOO 
LBNEXTs 
LBZ l a 
CHNAMEb 
U p B 
LEDEX 8 


CHNAM{l),LHNBXT(l)»WTFLOW(l).TTO(l)»PTOa>i 
TSOa),PSO(l);MACHOU>iAOU»,VARY{l) , 

RG( 1) ,GAMI1), NR(1),NC{D ,TAB(6) , 

BB(75) 

VARY 

VOID 

macho 

<VO,MACHO) 


LBDE 

increment TO NEXT BOUNDARY ^ ^ 

increment to the first boundary point (»0 BEFORE COALLATIO 
channel with which tH6 boundary data Is ASSOCIATED 
T OR F FOR UPPER OR LOWER BOUNDARY ^ 

relative index of L‘,E'; point when LOWER AND UPPER SURFACE 
Contours are connected 

BDNAME.LBA.'L'dBPNAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

data when boundaries are coallated 
dimension BDT< 1) ,UBNEXT|lx,LBZl(l» , 

1 chnameu) iup(i> .ledex(I) . 

2 Z8T(1),RBT(1)»ANGBT|42) 

LOGICAL UP 

integer BDT»(CHNAME,BDNAME 
DIMENSION BONAMEU) »LBAIX).LBB(1) 

equivalence tBDNAME*ZBT). (lBA»RBT>, (LBBiANGBT) 
table OF CONVECTED PROPERTIES 
INDEX- LTbLTO.LTE 
CH a CHANNELNAmE 

LTNEXTs index increment to the next channel 
relative location of PS! LIST 

NO. 8F PSIi TT* PT AND RCU VALUES 
relative LOCATION OF TT LJST 
relative location of PT LIST 
RELATIVE_LOCATION_OF RCg LIST 


LPSI 

npt 
ltt 

LPT 

LRCU 

DIMENSION 


1 

2 


CH(U *LTNExTa>*NPTa)iLPSlaJ*LTTIl) *LPT(lt« 

LRCU(1)i 

CRG<l),CPQJ(lJ ,C2CP<l>,QGAM(ll,FGm),FGPlir; 
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TGRd) iAREATB(4S5) 

dimension XCM(1) 

equivalence (CH.XCH) 

tabue of wake displacement thickness 

Index- iwaLWOiLwe 

dimension X2H(l).LUNEXTai,SlW(47) 

DjMgNSjON DST(l.) 

equivalence <DST,S1W> 

SuBTABLE arrangement IS- 

X2W,LWNEXT(42*2N), SlW (1 1 , SlW ( 2 > ; , ,SlW(N), DST ( 1 ) . DST (8 ) , ; ; DST (N > 
X2W a STREAMLINE COORDINATE 

SlW i; distance along streamline FROM t;e, 

DST s wake displacement thickness as a FUNCTION OF SlH 

FLOW adjustment TABLE 
Index- lf8LPO,lfe 
NFCOLSs 8 

KiF ■ ORThOqONal coordinate 

K2F a streamline COORDINATE Of SL EMINATING FROM T.E, 

XlBF 5 XliCOORDlNATE OF CHOKE STATION OF FLOW BELOW T.E, 

^lAF o X 1 "COORDInATE OF CHOKE STATION oF FLOW ABOVE TiEt 
SlF 9 SlicaORDiNATE OF T'.E, (UPPER SURFACE), THIS ITEM 
IS USED when interpolating -for wake delta-star, 

LFB.LFAalNDICES OF STATIONS BELOW AND ABOVE T.E*, 

NCHBiNCHAbNUMBER of channels below and above t,e, 

LRF B index of dummy ORTCHN LIST FOR THE T.E. 

LRXF 8 index of last channel BELOW THE T.E’. 

JORDERb 0 IF total FLOW AT XlF IS GIVEN 
8 2 IF FLOW ABOVE T.E’, IS GIVEN 
■ 1 IF FLOW BELOW T.E*. IS GIVEN 
JORDER8 -1 IF FLOW AT XlF IS CHOKED AND SINGLE CHANNEL 
dimension XlFa),X2F(i),XiBF(l)iXiAF(i), 

S1P(1),NcHb( 1).NCHA(1)| JORDER(l), VNR(12) 
equivalence <LFB,X1BF), (LFA.’XIAF), (lRF.NCHBI# ILRXF.NCHaI 
DIMENSION LF8(l)iLFA{l),LRra)iLRXFa) 

station Table 
Index* LsLOiLESta 

SCHOKE8 station CHOKE INDICATOR ( ADJWF i BRHS • WRI OUT ) 

mcl s SHARP Corner indicator (Bldtbs) 

mcl 8 field index of control streamline (PTM0VE»FL0BAL) 

COMMON /CHDATA/ XI ( 1 ) . LNEXT ( 1 ) i MLB< I ) # MUB(1 ) #PR IM ( 1 ) » 

1 TyPeLB(1),NaMeLb<1)i ILB{ l),FLB(l)»SlL8{i)i 

1 TYPEUB<1) ,NAMeUB<l)j lUB(l) ,FUB<l) iS1UBIi> I 

* VMB(1).DWDV(1)iX2CL(1)iSLSWI<1).MCL(1)i 

« ANGTE(l)iPTTEai*PSTEajiFQRTE(l)iRGTE(l)i 

« ANGEXP(1),BSQEXP(475) 

dimension CRVL£(1> ,ANGLE(1> 

equivalence <SCHOKEiDBDv);(CRVLEiANQTE).(ANGLE,PTTE) 

integer PRIMiTYPELBVTTPBUBiSCHOKEU) 

equivalence (CHNAM,BDT,CH,X2W,X1F,X1) 

EQUIVALENCE ‘LHNEXT , LBNExT^LTNEXT , LWNEXT . X2F , LNEXT ) 
equivalence (WtFLOW,LBZl;NPT';slH|X*BF.MLB) 

EQUIVALENCE ( TTO • CHNAME • LPSI . XlAF » MUB ) • (PTO» UP i LTT • SlF , PR IM ) 

EQUIVALENCE ( TSO . LEDEX ,LPT;NcHBi TYPELB > 
equivalence (PSO.ZBTiLRCU.NCHAfNAMELB) 
equivalence ( macho, RBT,CRQ fUORDER, ILB), ( AO, ANGST, CPGJ, VnR;FLB ) 
EQUIVALENCE ( VARYiC2CP*SlLB) »' (RG*Q6 AMiTVPEUB) 

equivalence (GaM,FGT,NAMeUB)V <NR,FQR, IuB), (NC,FGR,FUB) 

EQUIVALENCE ( TAB ( 1 ) , AREATB, 81UB> » (BB, ANGTE ) 

equivalence (TA8(4),x2CL) i(TAB(5) iSLSWI ) i ( TAB< i MCL » 
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COMMON /ALLCOM/ MACHA, PS A, TSA;Pt A, TTA, AX I A. RGA, GAMA, 

1 MACHCiPSc,TSc;ptc,TTc, aXICi'RGC.GAMC, 

2 DAXIT,SCALEA,TTEiCHOTST 

real MaCHA.MACHC 

LOGICAL AXIA.AXIC 

COMMON /CaTAN3/ DANG 
COMMON /CB / 0(300) 

COMMON /CBEAH2/ DR , OZ , YP A , YPBir.’Q , DX , YQDX , Zm , RM , ANGM , CURVM i SlM| 

1 RZOMLYi ANGCHO.SINTVLi VPASO , YP AB , YPBSQ 

LOGICAL RZONLY 

COMMON /C81TS / BITSiBlANK 
Integer blank 

COMMON /CIDE* / M, J.MU.MD.ISTaG 

COMMON ^CM ^ JMS(300j 

Common /cpi / pi i thopi »pk52.p1Q4iTODEg.torad 

COMMON /CR / R(3Q0) 

COMMON /CRHS / WSL<300) 

common /cs2 / 52(300) 

Common /ctabpr/ utab 
COMMON /CvW / VM(300) 

COMMON /CZ / Z<300) 

COMMON /ERASE / XX U ) , YY , AN6G,NL . NT, CNL .CNUtBNL , BNU i NZERO 
COMMON /IxOflIG/ LMOiLHE* LBD0*LBDE# LTO.LTE. LWOiLWE* LFOiLPEi 
« L0,LESTA,LS0,CSE,LDUM<6), 

» M0,NM, Nj.NFCOLS, MAXNJ.MAXQL.MAXNMiMAXLE, 

* LEO.LEEi LROiLRl.LRD 

table of LEADING EDGE AND TRAILING EDGE POINTS 
INDEX- LEsLEO.LEE.lO 

NL£iNTE«NO. 0F L.E, and T.E'. COINCIDENT PTS. RESPECTIVELY 
CHUiCHUeNAME oF ChAnnEl ABQVE AnD BELOW PT» RESPECTIVELY 
BDLiBDUaBOUNfiARY NAMES ASSOCIATED WITH THE POINTS 

NUSED c COUNT OF TIMES THAT POINT USED IN CONSTRUCTION OF /ORTCHN/ 
COMMON /LETEPT/ XE(U,YE{t);AMGE(l>,NLE(l>,NTE(l>, 

1 CHL<1) »CHU<1),BBL<1) ,BDU<1) • NUSED U9l) 

integer CHLiCHUiBDLVBOU 

Table or channels embraced by each orthOqonal 

INDEX- LR=LRO,LREiLRD 

LRD e number oF channels plus ONEi LR index INCREMENT 
LEDGE a Index of- the orthogonal point In the letept-table 
LRPREV* pointer of line of upstream channels in ORTCHN'TABlE 
chna a Channel names 

common /ORTCHN/ LEDGE ( 1 ) iLRPREV ( 1 I iCHNA ( 479 ) 
dimension JCHNA(l) 

EQUIVALENCE (JCMNA.CHNA) 

integer Chna 

common /SPACER/ maxlh,maxlt;maxlf,maxlw 
Common /sltab / w(i28) ,X2U28 J .slchnuzb) 

.integer SlCHN 

COMMON /TROUBL/ ERRiERRMAJ, INERR.PRERR 
LOGICAL ERRiERRMAJ, 1NERR»PRERR 

integer CHNX,CHX,FIXCHN';hLE,HTE,SOL1D 

logical UPT 

data SOlid/SHSOLID/i HLE/2HLE/, HTE/2HTe/ 

C USE INPUT SPACERS TO SET TABLE ORIGINS 
LTE a LBDE 
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LTO « LTE*t 

LWE 8 LTE*HAXlT 

LwO 8 Lk|E*l 

>-FE 8 LwE*HaXUW 

LFO e LFE*1 

LESTA 8 LFE*nAXLF 

LO 8 lESTA^I . 

c ASSUMED Initial field velocity 

IFIMACHA.NE'.SITS) TTA»TSA#t i , aAMA*i’, )«MACHA#«2> 

VMlNITs ,4«S0RT(RQA«TTA> 

C»* bUlLD orthogonal-channel TABLE 

c« build ordered list of channels from l,e, connections 
c Search fqr the first leading edge pt (nle »2 in letept.tableI 

LR3 s LRO 

LRE 8 LR3-1 

Lx 8 0 

DO 505 LE8^E0,LEE,10 
505 IF(NLE(LE) .60.2) GO TO 510 

c NO l.e; PtS 

Go TO 535 

c LEsFIRST edGB pt, find connecting channels 
51G ChnA<LR3)8CHU(LE) 

ChnA(LR3*1)sCHL(LE) 

^•RE 8 LR3*1 

c search For channels below CHNA<LR3| 

5l5 Do 517 LE3»L60,LEEi10 
LEX 8 le3«LX 

517 IF(NLE(LEX) iNE’.O .AND, CHL (LE3> ’.EQ iCHNAt LR3 > ) GO TO 520 
WRITE (6,l56fl) CHNA(lR3) 

Call errori 

c check fGR bottom channel 

520 IF(CHU(LE3) *,Ba;BLANK) GO TO 525 

C MOVE CHU(LE3> below CHNAIlR3> 

CALL M0VE(2, CHnA(LR 3) ,CHNAaR3*l| ,LR3«LRE-1,1, 

1 CHu<LE3) ,CHNA(LR3);1#U 

URE 8 lrE*1 
GO TO 515 

c Search for channels above chnacl'RE) 

525 DO 530 LEA^LEO , LEE i 10 
LEX 8 LE4*LX. 

530 IF(NLE(LEx) .NE.O .AND. CHU<LE4I .BQiCHNA(LRE) ) GO TO 532 
WRiTe (6, 1560) CHNa(LRE) 

call errori 

c check for top channel . 

532 IF(CHL(LE4);BQ;8LaNK) GO TO 535 

C MOVE, CHL(lE4} ABOVE CHNA(LRE) 

LRE 5 LRE*1 
CHNA(lRE)«CHL(LE4) 

GO TO 525 

c rEreat the above For the trailing edge 


132 



c 


53b ira^.EQ.l) GO TO 545 
LRl s LR3 

LR2 s LRE 

^E1 B Le3 

LE2 « LE4 

LR3 * LR2*1 

LX s 1 

Lx a 1 TO PICK UP NTE(LE3) RATHER THAN NLE(LE3) 

C SEARCH roR THE LAST T.E. PT 
LE = LEE*$ 

540 IF(NTE(LE) ;E§;2) go TO 510 
LE a LE-10 

IF(LE.GE.LE0} go to 540 

c NO |.,E. OR t;e; PTS 
545 rr(LRE»LRl) 947 , 555,555 
547 LE a LEO 

IF<CHl<LE) .NB.BLAmK) go to 558 
lF(CHU(Le)*.NB;8LANK) GO TO 552 

Call errori 

55P CHNA<LRl)aCHL(LE> 

Go TO 554 

552 ChNa(LR1)8CHU<Le) 

554 LR2 a LRl 

LR3 a lR2*1 

CHNA(LR3>aCHIiA<LRl) 

>-R£ a UR3 

c check for extra channels in lETEP-TABLE 

555 LE a lEO 

556 IF(CHULE)'.ES;BLANK) go to 558 
CHX a CHL<LE> 

LX *0 

Go TO 560 

558 lF(CHU(LE)'.Efi'.BLANK) GO TO 564 
CHX a CHU<LE) 

LX a 1 

560 DO 561 LRsLRI.LRE 

561 1F(CHNA<LR) iGa’.CHx) GO TO 562 
ERR s ,TRUE; 

write (611568) CHX 

562 IF(LX) 564i’558,564 

564 LE a lE*10 

IF(LE.LT'.lEE) go to 556 

C LINE UP The l'.'e; and t.e, connected channels in the same column 
c LRL a INDEX OF CHANNEL IN FIRST LINE (L,6‘. CONNECTED CHANNELS) 

C LRT B index of CHANNEL IN SECOND LINE (T,E. CONNECTED CHANNELS) 

LRL = LRl 

LRT a LR3 

GO TO 586 

570 ir(LRE.LT'.LRT) GO TO 576 
DO 575 LRXaLBT.LRE 

575 IF(CHnA(lRX) -EQ.ChNAILRL) > GO TO 588 

C LRL-ChANNEL NOT INCLUDED IN SECOND LINE,' PUT IN BLANK SPACEi 
CALL MOVEll. CHNA(LRT) *CHNA(LRT*1) iLRT«LRE«i»l) 

578 lrE a LRE*1 
CHNA(LRT)3BLANK 
Go 70 506 
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5b0. 

5«2 


584 


C 


LRX matches LRLi PUT IN LRX-LRT BLANKS BEFORE LRL 
LDR 

IF(UDR) 

LRTO s lRL*LDR 

Call M0VE(1, CHNA(LRL),CHNA<LRTO)iLRL-LRE-l.l) 

LRE e LRE*liDR 


« LRX-LRT 
502,586,582 


LRT e LRT^LDR 

LR2 « LR2*LDR 

ChNA(LRL )sBLANK 
LRL 8 LRL*1 

LRT 5 lBT*1 

IF(LRL«LT*LRT0) fin to 584 

IF NO channels On first line* Set first value to thaT of Second 
IF(LR2?.LDR*.LT;lR1) CHNA{LR1)sCHNA(LR2*1) 


586 LRL * LRL*1 

LRT a LRT*1 

588 IF(LRL.LE’.LR2) go to 570 
IF{lRT,gT'.lRB) gO to 600 

LDR s LRE-LRT*1 
GO TO 582 


c define ortchM-table increment, lRd 

600 LRD 8 LR2-LR0*3 

Call M0VE(1i CHNA(LR2 + D ,CHNAfLR2*3> ,LR2-LRE,D 

LRE a LRE*4 

1-EDGE(LR0)s81-aNK 

LRPREv(LR0>8BlANK 

LRPRV a LRO 

LR a LR0*LRD 

LEDGE(LR)aBLANK 

LRPREvtLR)*8liANK 

LR a LR*LRD 

if(Err) call ERRORI 


C« 


C 


build streamline table 
N j a 0 

LRL ® LRO 

LRT a LB0*LRD 

X2SAVla 0- 
X2SAV2a o; 

DAREA a 0. 


602 


SEARCH FOR FIRST COMMON CHANNEL 
LRXl a URL 


LRX2 - 

NbLNKjs 


LRL*L'rD 

0 


605 


NBLNK28 0 


IF(CHNA<LRXI J ;EQ,CHNA(LRX2) ) GO TO 610 
IF(CHnA(Lrx1) .NE. BLANK) NBLNK1*nBUNK1*1 
IF(CHNa(LRX2) ;Ne.b 1-ANK) NBLNK2BNBUNk2*l 
LRXl 8 URXl^l 




^ 8 lRX2^1 

F(LRxi;LE'.LR2) 


So TO 605 


610 DX2 a 8>ARAX0(N3LNK1,NBLNK2I 

if(dx2.eq;o; J go to 620 

IF<NBlNK1.NE70) DEl18Dx2/FL0AT<NBLNKD 
IF(NbLNK2'.NE*;o> DEL23DX2/FL0AT<NBLNK2) 
612 1F(CHNAIlRL)7EQ;BLANK) go to 615 
CHX 3 CHNAIlRLI 
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X2(NJ + IUX2SAV1 
X2SAV1S X2SA\/1*DEL1 
X2(nJ*2>=X2S4V1 
Go TO 625 

6113 CHX a CHNAtLRTJ 
X2(NJ*l)aX2SAv2 
X2SAV2* X2SAV2*DEL2 
X2(Nj^2)ax2SAv2 
Go TO 625 

620 CHX a CHNAfuRL) 

X2(NJ+l)ax2(NJ> 

^F(NJ.EQ,o) X2(NJ*l)aO, 

X2(NJ*2 »sx2 (NJ*1U8. 

X2SAVlaX2(NjA2) 

X2SAV2aX2{NJ^2) 

SLCHN(NJ*l)aCH>^ 

SLCHN(NJ*^)3CHX 

W(NJ*l)aO . 

DO 630 LElaLEO.LEEilO 

IF(NLE<LE1) ;mE,0 .and, 

DO 635 LE2s(^EO,LEE>10 
lf^(NLE(LEa) tNE, 0 iAn|D, 
aREA a YE(LE2)-YE(LEI) 

1F(AX1 A) AREASAREA*PU(YE(l.Eg)*yE(UEi) ) 
c FOR Inlet conf. save highlight area so external area 

c MAY BE COftREcTED BY DIFF BET HIGHLIGHT AND CAPTURE AREAS, 

AREASVa AREA 

IP (CHNA(LRL)'.NEt BLANK) ARE AaAREA*DARBA 
call BC0NV4CHX,LT#AREA) 

IF ( CHna( LRL ) ,NE, BLANK) DAREAbDAREA + AREASV- ARE A 
LT a LT^LPSKLT)*NPT(LTU1 
WCNJ*2)aXCH<LT) 
a NJ*2 

LRL a LRL*1 

LrT a LRT*1 

IfiLRL.Gt'.LRJ) go to 639 
IF(LRL-LRXI) 612*620|602 


625 


630 

632 

635 

637 


CHLaElTtEQ.CHX) GO TO 632 
CHUILE2 ) iEQiCHX) GO TO 637 


c** begin LOOP for building 
c EACH orthogonal. 

639 LRPRV a LRO 
0 

MO 
LO 
LFO 

TTEaTTE 


channel list, station Table and field data 


LRPRSVa 

M 5 

L 3 

LF a 

ttesq ? 


c» consider marked channels on line LRPLRPRV in /ortchn/ 
c . find index or first and last active iNONipBLANK) CHANNEL 

640 LRpi j- lpprv 

LRP2 a LRPRV*LRD-3 
642 IfccHNAILRPU'.Ne'.BLANK) GO TO 644 
LRPl a LRP1*1 
IF{LRp1‘,LE’,LRp2> go to 642 
call errori 

644 IF(CHnA{LRP 2);NE. BLANK) GO TO 646 
LRP2 a LRP2-1 
GO to 644 


646 


Find 

le 


iNdex^le 

* LEO 


Of next lE«Te PT fN lRPRV.CHANNelS 
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64B lF<NUSED(LE>*NLE<LE)-NTEaF» ) 650|«54,654 

650 LEONCEs NUSED(LE) 

IF(NTe{LE>',NE'.0) leonceso 
LRP a LRPl 

652 IF(CHNA(LRP)7E0;BLANK) GO TO 653 

IF (CHNAtLRPl •£QtCHU(UE> .AND. LEONCE.lE.O) GO TO 660 
IF (CHNa1lRP>7eO.CHL(LE) ) GO TO 665 

651 LRP P LRP*1 
IF(LRP.LE’,LRP2) go to 652 

65A LE a LE*10 

IFCLE.LE’.LEEI GO TO 648 
C NO MORE POINTS 

call ERRORl 

C LE IS UPPER boundary POINT (COWER ORTHQGONALI 

660 LRP2 s LRP 
UPT a '.true; 

Go TO 670 

C LE is lower boundary point (UPPER ORTHOGONAL) 

665 lRPI a LRP 

upT 8 ;false; 

c mark channel Names of the new orthogonal on line lr 
670 Call setm(1, Blank, leoge(lR) .LRo) 

LRl 8 lr * lRP1"LRPRV 

LR2 8 Lr. * LRP2-URPRV 

Call MOVE(i, CHNA(LRPl)iCNNA{LRi>iLR2"LRl*l*l) 

LRE 8 lR*LR0-1 


C 


UPDATE USED LETEPT COUNT AND SET POINTERS FOR LINE"LR 
672 NuSED(LE>aNUSED(LE)*l 
LRPREv(LR)sLRPRV 
LEDGE{LR)aLE 



LEOGE(LRli.LEDQE(LR) 


C 


COUNT number QF channels, SET FIELD TABLE LIMITS 


675 


NCHNA s 0 

DO 675 LRK8LRI.LR2 

IF (CHNAILRX)'.'nE ’.Blank) NCHNA*NCWNATi 
M j_ s M 


MLB(L)a Ml 

M2 s mi*nghna*nchna«i 


MUB(L)a M2 


NM a M2 
L6STA * l*20 

G IF upstream or downstream boundary, search for other EDGE 
IF(NLE(LE) IE6',1> go TO 679 
IF(NTE(LE) .E0*1) go TO 68i 
go to 720 
679 Lx P 0 
Go TO 682 
6 B 1 LX s.l 

682 IF(.NOT'UPt) GO TO 690 

C FIND LOWER EDGE PT 
684 DO 686 LE1«LEO,lEE, 10 
LEX a LE1*LX 
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686 irtNLElLExi’.EQ'.l ,^N0, CHL(LEl) '.EQlCHNAtLRU) GO TO 668 
CALL eRRqRI 
688 LE2 e lE 

NUSED(LElisMUSED<LEl>*l 
GO TO 700 

C f IND upper edge PT 
690 DO 692 LE2»LE0 i LEE i 10 
LEX s LE2*LX. 

692 lF(NLE(LEy>«EQil .<^NDi CHU( LE? > . EQ » CHNA( L«2 U GO TO 694 
CALL ERRqRI 
694 LEI s LE 

NUSED(LE2)sNUSEQ(lE2)*1 

C» PLACE UPSTREAM OR DOWNSTREAM BOUNDARY DATA INTO STATION TABlE 
700 NaMELB(L)sBDL<LE1) 

NaMEUb(L)=9DU(LE2) 

1F(NTe(LE) -EBil) GO TO 710 

c upstream boundary 

lLB(L)a 1, 

FLB(L)i 0. 

SlL8(L)aO'. 

UB = LBF{NAMEU8(L) ) 

lUatL )» (^.BNEXT(LQ)-9-LBZJ (LBJ >>'3 

FUB(L)4 1. 

Call BARC(LatL8NEXT(L0).12> 

SiU 8(L)»S1NTVL 
Go TO 715 

C DOWNSTREAM BOUNDARY 

710 LB B LBF(«AMGL9(L) ) 

1L8(L)b (lBNExT(L8)-9-L8Z1(LB})/3 
FL8(U)a l', 

CALL 8ARC(LBtLBNEXT(L8)-12> 

silb<l)*sintvl 

IuB(L)= 1 
FUB(l.)s o', 

SlUB<L>aO; 

715 ZCMl) a XE<LGD 
^CNi) YE(LEI) 

Z(M2) P XE(UE2) 

R(M2) a YEO.E2) 

GO TO 800 

find LE OR tE orthogonal LOWER BOUNDARY INTERSECTION 
PLACE DATA IN. STATION TABLE 
USE LETEPT*TaBLE to determine name OF UPPER BOUNDARY 
720 IF(NLETE.EQ;2 ’.or. NLETE.EQ'.OJ SO TO 722 
CALL ERRORl 

722 IfI.NOT'.UPT) GO TO 740 
Do 725 LE1 »LEOiLBE, 10 
IF(CHL(LE1) iEQ'.CHNAlLRin GO TO 726 

725 Continue 

726 NAMELB(U)sBDVi(LEl) 

NAMEUB(L)aBDU(LE) 

CALL OBI(XE(LE),YE(LE),ANGeaE)';BDLfUEl).qHL<LEl)i 
1 ILBa)iFLB{L)iSlLBCLJi Z<Ml)iR(Ml)) 

c Seek pointer to boundary table 

LB a l8F<NAMEUB<L> ^ 

IRET si, , 

IF(NTE(LE) *NE.2) GO TO 728 

c trailing edge 
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1 V B ^ 

L8 s LB*LBZKLB) 

Go TO 733 

c leading edgb or corner 
LBl s LB*LBZ1(LB) 

LB2 s LB*lBnjExT (LG 

I V a 1 

DO 730 UBaLBl,LB2,3 

IF<ZBT(LB> :EQ;XE<LE) ,AND. RBT< LB^ , EQ , YB< UE > > GO TO 732 

730 IV s lv*l 

CALL ERRORl 

c temporarily store sharp corner indication in mcl<l> (i,e, angle 
c JUMP or more than 0,5 deg’.) 

^32 MCL(L)s 2 

IP<NLETE.EQ;0 ’.and, A8S(ANGBTeLB)-ANGBT|LBv3)),GT.;0087y McLtL)*l 
lr<lRET» 733v753,733 
luB(L)* IV 
rU8(L)a o; 

SlUB<L)sO; 

Z(M2) a ZBT(LB) 

R(M2) a RBT(LB) 

GO TO 800 

C PiND IE OR TE orthogonal UPPER BOUNDARY INTERSECTION 
C PLACE data in STATION TABLE 
740 DO 745 LE2*LE0 , LEE , 10 

Ir(CHuaE2)'.EQieHNA<LR2n GO TO 747 
74t) CONTINUE 
747 NAMELB(L)a8DL<LE> 

NAMEUB(L)aBDU(LE2) 

Call 0B’(xE(LE),YE(LE),ANGE(Lg)’;BDUfLE2),CHU(LE2), 

1 1UB(lJ . ruB<L) ,S1UB(LJ • Z<M2>»R|M2)) 

C SEEK POINTER TO BOUNDARY TABLE 
LB a LBF(NAMELB(L) ) 

IRET a 0 

IF {NTe(LE)’.Ne;2) GO TO 728 

c trailing edge 

LB2 a LB*LBnEXT<LB)- 9 
lL8(L)a (LB2-<L84LBzi(LBn )/3 
PLb(L) 3 i'. 

Call barc<lb*-3) 

S1LB(L)»SINTVL 

LB a lB2 
GO TO 757 

C leading edge OR CORNER 

753 lL8<L)a ly 
FLB(L)a 0* 

SiLB(L)8q; 

757 ^Tmi> e 40jl^;0) 

R(Ml) B RBTILB) 

• ADD NEW field POINTS ALONG EXISTING STREAMLINES 
GI VEN- 

stasTab index l and limits on field index MLB.MUB 
coordinates of first AND LAST NEW PTS IN FIELD TABLE 
Marked channels in ortchn table between lR1iLR2 
streamline table- 
800 MSAV * mo ' 

MSAv. ■ 0 indicates upstream boundary 

‘F{NLe(Le,;|Q;i, msaVbO 
Jl 
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CALL JOrCHN(CHNA(L^l) I Jii JX> 

CALL J0FCHN(CHNA(L'^2) . JXi J2> 

C •^ 1,^2 A«E SL index LIMITS 

C BEGIN LOOP through CHANNELS,' 2 SLS PER CHANNEL 

LRN = LRl 

mm s Ml 

JSL s Jl . 

805 Ir(CHNA(LRN)';EQ. BLANK) GO TO 035 
CALL JOFchN(GHNA(L^N) , JSL.JNXT) 

c find upstream field pt, put in downstream pointer 

810 j - jsL 

IF(MSAV) 8l2k828»812 

812 IV s 0 

815 Do 820 M=mSAV.NM 
call GETIX 

8^0 IF(J,EQ’.JSL VaND, HD.EQ.O) 60 TO 825 
IF(IV;nE.o) CALI, errori 
MSAV 5 MO 
I V SI 
GO TO 815 

825 MSAV = M 
MD s mm 
call SAVIX 

c S/^VE daTa for current field pt 

828 M s 

MU = MSAV 
MD a 0 
ISTAG s 0 

Call savix 

ADD CHANNEL FlOWS FoR LATER INTERPOLATION OF Sl POSiTiqn 
IF NOT AN upstream BOUNDARY, USfi UPSTREAM AREAS IN PLACE OF FLOW, 
•USE CURV FOR STORAGE 

wsl(M)s_ o; 

IF (MiEQiMl) So TO 830 
WSL(M)b WSL(M^1)^W(J) 

IFCMSaV'.EO'.O) go to 830 

Area s sqrt<(R(mu)-r<mumi))*(R(mu)*r(mumim * 

1 (Z(MU)^Z(MUMI) )*tZ(MU)-Z(MuMl) > ) 

IF (A^IA) AREA=IR^MU)*R<MUM1))«AREA 
WSLCMJb WSLIM-l )*AREA 

830 mm » MM*1 
MUMI = MU 

IF( JSl.EQ; JNXT) GO TO 835 
JSL 5 jnXT 
Go TO 810 

C increment to NEXT CHANNEL 

835 LRN s LRN^l 
IF(LRN,LE'.LR2) go to 805 

c interpolate for coordinates 

I F(, NOT '.AX I A ,OR, R ( Ml » . QE jO ', ) QO TO 836 
WRITE ( 6 * 1835 ) 

CALL ERRORi 

836 DZ21 s Z(M2)-Z(Ml) 

Dr 21 a R(m2J,R(M1) 
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DRSQ 21 S DR 2 l#<R(M 2 >*R(Min 

RMiSQ s R(Ml)i*R(Mi) 

S2(Ml)s o'. 

S2(m 2)8 S0RT(DZ21»D221*0R21#Dll2t> 

CHECK rOR POSITIVE OL LENGTH 

ANGREFs AMGEtLEl 

AHGOL 3 ATAN3(DR21»D221*ANQREF» 

IF(DANq;qE'.0. .and, DANG'.LT'.PI » GO To 837 
WRlTE(6Vt837) Z(Mt) ,R(M1) ,2(M2 > iR(M2J ,UE,LR , ANGREF 
call ERRQRl 
637 VM(Ml)s VMINIT 

Vm(M2)s VmINIIT 
Mp s Ml*l 

mm a M2-1 

IF(MM.LT.MP) gO to 840 
Do 838 MsMPiflM 


VM(M) 

F 


8 

a 


VMlNtT 

( WSLF^O-WSKHl > )/(WSL<M2)«WSL(M1) » 

Z<M1J*F«DZ21 
R(MlJ *r»DR2l 
F«S2jM2) 

IF ( .NoT’iAxlA) GO TO 838 

Sort i^rml^d^f 3oRSQ2j,j 

SqRT( (R<M) 3R(M1> )ii(R(H)iR<m> )*{F»DZ21) »(r»0Z2li > 


Z(M) 

R(M) 

S2(M) 


”CM> 
R 2 (M) 
Continue 


FINISH OUT STATION TABLE 

check for l'.e;, t.e, or sharp corner 
LE 3 index of PT in LET6PT«TABLE 
NLETE a 0 is a sharp CQRNER 
640 Xi(L> a 8>FU0AT( (LE*lsLEO)/lO> 
LNEXT <L >S20 
TvPELBCDaSOLID 
TypeU0(L)bSOLID 
X2Cl<l)3BitS 
‘F(NLETE.EQil) QO TO 848 
IF(UPT) GO T6 842 
C UPT=F 

X2CL<L >»X2< Ji ) 

^ a MLB(^) 

Go TO 843 
C UPTfT 

842 X2CL<L)aX2( Jl) 

M a MUBOi) 

843 Call getix 

IF(NUE(LE) 1NS;2) go to 845 

ISTAG a 1 

LNEXT(L >322 

IF(UPt) Go to 844 

TYPELBIDbHLE 

Go TO 845 

844 I’yPeUbIDcHLE 

845 IF(NTe(LE):NE;2j GO TO 847 
ISTAG s 2 

LNEXT<L)a27 
BSQEXPiDaBiTS 
IF(UPT) GO TO 046 
TYpeL 8 (L)aHTE 
Go TO 847 

846 TYPEUB(L)aHTE 

047 IF(NLETE.EQ;0) 1STAQ»MCL(L) 
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sAvix 

8A» VM8(L)s VI^IMTT 
DWDV (L) = 0 '• 

SLSWI (L ) = o; 

P^IM<L )«1 
M s MUB(L)*1 

LSAVF = L 

L » L*LMEXT(L) 
LEsTA s L-1 


880 


885 

860 


862 


ABOVE lVE, 
OR LOWER T: 


IND£x to next orthogonal 
moK For orthogonals to be placed 
IF THIS IS A downstream BOUNDARY 
IF(nTE(LE);EQ;0) go TO 920 
IF(NTE(LE) ,Ea.l) GO TO 855 
MTE(LE)s 2 

IF<nUSED(lE>'.'EQ;2) go to 900 

LRX a lR 

LRX a LRPREV<LRX) 

LRPREVs blank for upstream or dummy ORTcHNcLISTS 
IF(lRPREV(LRK) ;EQ,3LANK) so to 862 
lF<ue0GE(LRXr.LE*0 ) GO TO 850 
LRPRV , LRPReV(LRX) 

GO TO 864 
LRPRV a LRPRSV 
LRPRSV* 0 


POINTS 
E. ORTHOG 


IS THE channel on the OTHER SIDE OF THE T',E, IN THE LRPRV*LlST 
864 IF(nTE(LE);NG;2) go TO 9i5 
CHNX a CHU(LE) 

IF<UPT> CHNXaCHL(LE) 
iF(LRPRV.EO'.fl) GO TO 870 
LRX2 a lRPRV+LRD-3 
DO 866 LRX*L(*PRV»LRX2 
866 IF(CHNA(LRX)7E0’.CHNX) go TO 925 
DID not fin* ChNX» SAvE LRPRV 
IF(uPPRSv;NE70) call ERRORl 
LRPRSVs LRPRV 


C find upstream boundary which includes channel CHNX 

870 LR a UR*L«D 

Call sEtm(i, blank, lEdge<lr) ,lrd> 

LRE a LR*LROrl 
LRPRV s lR 0*LRD 
LRPl = LRPRV 
LRP2 a LRPltLRDv3 
DO 872 LRPaLftPl,LRP2 

872 lF(eHNA(LRP>',*EO:CHNX) GO TO 873 
call ERRORl 

873 Lri s LR*LRP"LRP1 
CHNA(LR1)=CHNX 

LR2 a lri 
t-RPl a LRP 
LRP2 s LRP 

c Search for channels below chnailRI) 

878 Do 876 LE l«LEO • LEE 1 1 0 

876 IF(NLE(LE1);NE;0 .AND. CHL ( LEl ) EQ , CHNA ( LRI )) GO TO 878 
60 TO 896 

C CHECK FOR bottom CHANNEL 

878 1F(CHU(LE1> ’.EO'.BLANK) GO TO 884 


141 



oo o 


C USE CHU(uElJ AS PART OF THE UPSTREAM BOUNDARY 

8B0 LRPi s LRPl-l 
LRl = LRl-1 

lF(CHu<LEn ’.EQ’.CHNAdRPl) ) SO TO 882 
iFaRl’iGT’.LRJ GO TO 880 
GO TO 896 

882 CHNA(LRI)sCHU(LE1 ) 

Go TO 875 

c Search for channel above lR 2 

884 DO 888 LE2sLEO.LEEi10 

888 lr(NLE<LE2) ;NE.0 .AND, CHU( LE2 ) EQ , CHNA( LR2 ) ) GO TO 892 
Go TO 896 

C CHECK FOR TOP CHANNEL 

892 IF(CHL(LE2) ‘.EQ’.BLANK) GO TO 899 

0 USE CHL(lE2J as PART OF THE UPSTREAM BOUNDARY 

894 LRP2 s LRP2fl 
LR2 s lR2*1 

IF(CHl(LE2) ‘,EQ’.CHNA(LRP2) ) 00 TO 898 
1F(LR2,LT ;LRE) go to 894 
896 Call eRRori 

C REFER ALSO TO EFN 876, 882,888, FOR THE ERROR 

898 ChnA(lR2)bCHL(LE2) 

GO TO 884 

899 lE e lei 

s .FALSE'. 

GO TO 672 

trailing edge pt With orthogonals on both sides, build dummy 
lrprv-list to represent coalescing OF upper and lower streams; 

LOOK BACK FOR ORTHOG ON OTHER SIDE OF t'.E, 

900 DO 9 O 4 LRP*LRp,LRE,LRD 
904 IF(LEDGE(LRP«J .EQ.LE) go to 908 
908 LEDGE(Lf^P)*-LEDQE<L'^P) 

LRXl ■ LRP 
LRX2 s lR 

LR = LR*LPD 
LRX 8 LR 
LRE 8 LR*LRD^3 

Call setm d, blank, ledge < lr > ,Lrd) 

LEDGE(LR)bO 
LRPREV(LR)»L*X2 . 

910 IF(CHnA(lrx 11 .NE. BLANK) CHNA ( LRK ) ICHNA ( LRXl > 

IF (CHNA(LRX2};NE; BLANK) CHNA ( L^X ) pCHNA ( LRX2 ) 

LRXl 8 LRXl*l 
LRX2 8 LRX24-1 
LRX r Lrx*1 
If(LRx,Le;lre) go to 910 

LRE i LRE*2 
C BUILD flow adjustment TABLE, /CADJWF/ 

lmi 8 lsave 
5(1F(LF)*X1(LM1) 

X2F{LF)8X2CL(LM1) 

SiF(LF)saNGEILE) 

LM2 = LO 

911 1F(LM2,Ge’.LBSTA) GO TO 912 
IF(X1(LM2) •E^*XKlM 1) ) GO TO ’l2 
LM2 8 LM2*LNEXT(LM2 ) 

Go TO 911 
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912 If(UPT) go T8 9l3 
UFB(LnsLM2 
LfA(Lf)»LMi 
LRXF<L r>sLRl»l*L'RD 
Go 70 914 

913 UFB(LF)«LMl 

UFA(LF)^LM2 
LRXF (Lr)sLR2*LRD 

914 LRF(LF>sLR 

VNR(UF)* O; 

LF a LF+NPCOUS 

LFE s LF;i 

Go TO 920 

c downstream boundary, are all l;e; orthogonal completed 

915 iFCLRPRV.liJE’.ft) GO TO 925 
IF(LRPRSv •EQ*0) GO TO ^30 
LrPRV a LrPRSV 

GO TO 925 

920 LRPRV a lR 

925 lR a LR*lR0 

Go TO 640 

Caa« RELOCATE CONTROL STREAMLINE, XgCL’, To THe FIRST PRIMARY OF REGION 
930 L s LO 

935 LPl a L*LNEXT(L) 

IF{ (LPl)i GEiUESTA) GO TO 960 

iF(xm,Pi);i.6;xi<L) ) go to 940 
IF(X2CL<LP1)':eQ.BIT9) GO TO 950 
X2CL<L)«X2CL/lP1) 

GO TO 950 
940 X2CL(L)«BITS 
950 L a LPl 

GO TO 935 

960 L a LO 

IF(X2CL<L)’.Ne‘.BlTS) GO To 980 
M a MLB(L) 

call GETlx 
X2cl<L)»X 2( jj 

c build wake displacement thickness table, /WAKETB/ 

9a0 IF(LFe;LE'.LFO) go to 1139 
LF a LFO 
990 LBx a LFB(LF) 

LAX a LFAUiF) 

Ml ■ MUB(LBX» 

M a MLB(UAX) 

OZ21 a Z(M)’Z(Ml) 

OR21 a R{M)*R(M1) 

THK a DZ21 #dZ21*DR21»DR21 

dang a ATANB{DR2l,DZ21,StFaF))-Pl02-.SlF(LF) 

0 THE MEAN T.E. ANGLE WAS TEMPORARILY STORED IN SlF 

T^^K a COS(8 aNG)»SQRT(THK) 

^ IF(AXIA) THK4THK«PI »(R(M )*RIM1) ) 

995 CALL GETIX 

CALL BWAKE(JfcTHK) 

LF a lF*NPCOlS 

iF(lf,lt.lpej Go to 990 
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LOOP Through flow adjustment t*blE of t,b, sjat 
determine if flow is to be AD3USTED BELOW T.E, 
T.E; (JORDERpD# if total Fl'OU ABOVE*BElOW is 
c (JORDERsO), 8R both flows are fixed {UQHDERaS) 
LF s lFO 
1040 JORDER(LF)sO 

L a LFBILF) 

C LOOP TO FIND ALL CHANNELS BELOW (ABOVE) T.E'. 

M s MLB(L) 

FlxC^^Ns 0 

lobu Call getix 

c find index lh in channel Table 

LH a lHO 

106U IF(LH.GE.lHE) go to 1070 

1F{CHNAM(lH)'.'eO'.SlCMN( jn go to 1065 
LH = LH*LHNEXT(LH) 

Go TO 1060 

1065 IF( ,NOT;vARyfLH>) GO TO 1070 

C INDEX TO next CHANNEL 

M a m*2 

IF(M,lT;muB(L) ) GO TO 1050 
GO TO 108q 

C FIXED channel 

1070 FlXCHNf SLCHHIJ) 

c below t;e; 

lObO 1F(L.NE‘,LFB(LF) ) GO TO 1090 
IF(FIXCHn'.NEVo) JOROER(LF)al 
L s LFA(Lf) 

Go TO 1045 

c ABOVE t,e; 

1090 IFIFIXCHN’.NEVO) J0RDER(Lr)aj08DER(Ln*2 
X1BF(lF)=x1F(lF) 

XlAF(LF)aXlF(LF) 

Lf a Lf*NFcOLS 

1F<lF.LE.LFE) go TO 1040 


C eliminate gaps between EQUIVALENCED TABLES 

1139 NMOVE a lwE«LW0*1 

CALL MOVE(l, x2w(LW0) ,X2w(LTE« 1I, NMOVE, 1) 
LWO a LTE*1 

Lwe a lte*smove 

NMOvE- a LFE,LF0*1 

CALL MOVe<1, Xif(lF0),Xif{lWE«1),NM0VE,i) 
LFO a LWE*1 
LFE a LwEaMMOvE 

NMOVE a LESTA-LO*! 

call MOVE(1i Xl(LO) I Xl(LFE*l),NMOVEil) 

LO a LfE*1 
LESTA s LFE*RM0VE 

c . initialize B 

CALL SETM(1,1'./1024; , B,NM» 


IONS 

(JQRDER»0)i ABOVE 
TO remain constant 
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RETURN 


1560 FORmaT( iX47H6RR0<^-< CONNECTING EDGES WERe NOT FOUND FOR CHN*A6#22H 

• (SUBROUTINE BtDTBS)) 

IS 35 FoRMAT(/1X47H**» error-* NEGATIVE RADIUS ENCOUNTERED* AXI«Ti* 

• lOH (BlDTBS)) 

1837 FORMAT (20H **« THE FIRST PT (;2F9,3il5H) AND LAST PT <,2F9.3, 

1 26H) FOR THIS ORTHOGONAL (LE»«I5»4h LRstlSilH)/ 6Xi5lHARE NOT IN 
^The correct order for THE FLOW direction. F8*.4i 8HRADIANS./ 
36X,64HPRQBABLE CAUSE IS INCORRECT NAMING OR DESIGNATION OF BOUNDAR 
4 lES. ) 

END 
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•deck BwAKE 

Subroutine bwake( jx,thk) 

• BWAKfc- BUii;D make table 9BWAKE* 

INPUT- 

•JX » WfKE streamline 

THK b T.E. THICKNESS 


Table of wake displacement thickness 


Index, lmblmo.lme 

X2W(1).LUNEXT(1).S1WU7) 

DiMpNSiON DST(1) 

equivalence (DST,S1W) 

Subtable arrangement is- 

X2W,lWNEXT(» 2*2N), SI W <1 J , SlU (2 ) , , , SI W ( N ) , DST ( 1 ) , DST { 2 ) , ; ; DST < N ) 
X2W b streamline coordinate 


SlW e DISTANCE ALONG STREAMLINE FROM jlE, 

DST • wake DISPLACEMENT THICKNESS AS a FUNCTION OF SlW 


COMMON /IXORIG/ lho.lhe, lboo.lbde, lto.lte. LW0.LWE» lfo,lfe, 

* LOiLESTA, LDUMlSy, 

* MO»NM. NJ.NFCOLS* MAXNJ, mAXOL • MAXNM i MAXLE » 

* LEOiLEE, LR0*LRE»LRD 

DIMENSION LIMITS(24) 


equivalence (LIMITSiLHO) 

Common /sltaB / w(128),x2(i?8),slchn(128) 
I NTEGER' slchn 


110 


X200 


IF (LWE ,Qt;lwO) go TO UO 

LW s lWo 

X2w(LW)«X2( JX) 
s 1 w { L W ) « 0 

Siw(Lw*1)s107*ABS(THK) 

Siw<LW*2)bS1M(LW*1) 

Slw{LW*3)aslM(LW*2)*slW(LW*2) 

DsT(Lw*4)rTHK 

DST(I-W45jj.g- 

DST(LW*6)bO, 

DsT(LW*7)bO; 

N = A 

LwNEXT(Lw)a2tN*N 
LW = lw*LwnExt<lwI 

LwE s^Lgil 

WRITE (61I2OO) THKiX2(JX) 
formaT(4ih *#• error , Negative t,e, Thickness 
I- 8h at XI2?,F7,3,IM. ) 


return 

End 


Of 


# Fll , 5 # 
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•DECK Fill 

Subroutine filux, y,na,nb) 

CF ill 

c linear interpolation to fil vacancies in input lists 
Common -'cbi ts/bits 
Dimension X( lO) , y( lO) 
c find lAilB " vacant REGION 

lAsNA^l 

IF(y< IA-d’.EQ.BitS) go to 99 
DO 4 IsIa.'NB 

IFIYI I ) ’.NE". BITS) GO TO 5 
A Continue 
ib = nb 

Go TO 7 
^ 18 = 1-1 

IF( I iEQ’. I A) 80 TO 12 

c fill vacancies 

IF(y< IB*i);nE;y(IA*1) ) go to 9 
c All values the same 

^ Do 8 I 1 = 1 A, IB 
8 Y{ I I )sY( I A-1) 

GO TO 12 

c interpolate 

Dx a X(IB*1) - X< 1 A.l) 

Do 11 IlsiAifB 

,11 Y(M) c (Y(IB*1)*(X(1I >-X(lA-D) * Y( IA-1>»(X( IB*1>-X( 1 I ) > )/DX 
C GO SACK AND SEARCH FOR MORE REGIONS 

lA s IB*2 

IF ( I iLT'. NB-) SO TO 3 
99 Return 

fnd 
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•DFCK JOFCHN 

Subroutine jofchn< cmn# ja, jb) 

•JOFCHN strbamline index from channel name rjofchn* 

I'NPUT- 

CHN « Name of channel 

JA m streamline FQR WHICH SEARCH WILL BE INITIATED 


c output- - „ 

c ja.jb s first and last index Of streamlines belonging to ChN 


integer CHN 

common ''IXORIG/ LHO.lHEi L800,LBDE, LTO,lTE, LWOiLWE* LFOiUfE 
» LOiLESTA, LDUM(8)| 

« MO,NMi NJ,NFCOLS» MAXN J , M AXOL • MAXNM i MAXLE i 


dimension 
equivalence 
Common /sltab / 
integer slchn 


LEOiLEEi LR0»LRE#LRD 
LIMITS<24) 

(LiMITSiLHOi 

WU28) «X2( 1281 » SLCHN (128) 


I 


logical second 


SECONDS .false; 

J s JA 

55 IF(CHn;NE*.SLCHN( J) ) 30 TO 65 
IF(SECOND) Q8 TO 60 

seconqs ‘.true; 

JA s J 

60 JB * J 

Go TO 70 

65 IF(SECOND) RETURN 

^0 J S J4l 

*F(J,Le;NJ) so to 55 

IF( ,NoT;seCORO> call errori 

RETURN 

END 
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•DECK Obi 

SUBROUTINE 00 1 ( XPT , Y PT , APT , nAMBQY , NAMCHN. 1 . F A , SI , XB , YB ) 

ORTHOGONAt-SOUNDARY INTERSECTION »0BI» 

INPUT^ 

XPT s x-cOOr of PT on THE ORTHOGONAL 

YPT = Y-COOR OF PT ON THE OBThOGONAL 

APT = angle of SL perpendicular TO ORTHOGONAL 
NAHBDys bounbary name 

namchns name of Channel adjacent to nambdy 
output- 

r = interval of orthogonal-boundary intersection 
PA B fractional position in the interval 
Si = ARC distance from beginning of the interval 
xbiYb s coorbinates of the intersection 


c 

c 


c 


c 


c 


boundary table 
Index- lbslbdo,lbde 
lbnext» increment to next boundary 

LBzi e Increment to the first boundary point (so before coallatio 
CHNaMes channel with which tHe boundary data is associated 
= T or F FOR upper OR LOWER BOUNDARY 
LEDEX s relative index of l'.e; point when lower and upper surface 
CONTOURS ARE CONNECTED 

BDNaME.LBA.LBBsNAME and index limits of specific boundary 
data when boundaries are COALLATED 
common /CHDATa/ BOT(l),LBNEXTei),LBZl(l>, 

1 CHNAME(U .UP<1);LEDEX(1> , 

2 ZBTa),RBT(l),‘ANGBT(42) 

LOGICAL UP 

integer BDTiCHNAME,3DNAME 

01 MENS I ON BDNAME< 1) ,LBA(1I .LBB( 1) 

EQUIVALENCE (BDNAME i Z8T ) . (L'BAiRBT), (LBB.ANGBT) 


COMMON /CBEAM2/ 
LOGICAL 

COMMON /IXORIG/ 


« 


DIMENSION 

EQUIVALENCE 


DR, dZ, YPA, YPB;f;g, DX, YODX, Zm,RM, ANGM,CURVMiS1M» 
RZONLY, ANGCHD.SINTVLi ypasq.ypab, ypbsq 

RZONLY 

LHO.LHE, LBDO.LBDE, LTO.LTE. LWO.LWE, LFOiLFE, 
L0,LESTA, LDUM(8»i 

M0,NM, NJ.NFCOLS, MAXNJ,mAXOLiMAXNM,MAXLE, 

LEOiLEEi lro*lre»lrd 

LIM1TS(24) 

(LI'MITSiLHO) 


COMMON /CPI / PI,TW0PI,PIQ2,P!Q4,T0DEG,T0RAD 
COMMON /TROUBl/ err.errmaj, inerr.prerr 
LOGICAL ERR.ERRMaJ, INBRR.PRERR 


logical fqei 

determine interval Index limits, lbi,lb2, of pnamboyr 

LB = LBF<RaM0DY> 

LBlO 5 L8*LBz1(L8) 

LB20 s L8*LBNExT(LB)-12 
L81 s L01O 

t-82 = lb20 

IF(LEDEX(l8)','NE; 0) GO TO 105 

BDmSLAb BpUNDARY MINUS STREAMLINE ANGLE 

BDmSLAs 0. 

^^(UP(LB)) BDMSLArPl 
Go TO 120 
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lUb LB2 s lB*LEDEX(L3>-3 
BdMSLAs pi 

IF(CHNAME(LBJ iEQ.NAMCHN) GO TO 120 
*-Bl a Lb2*3 

L82 a LB20 

bdmsua» o’. 

lF(CHNAMEaB*l) .EQ.NAMCHN) GO TO 120 
call ERRORl 


C 


C 


C 

c 


120 FGEl a '.false; 

no 150 LBaLBl.LB2i3 
nz a ZBT(LB*3) -Z3T(LB) 

Cr a RaT(LB*3)-R8T(LB> 

SB a SQRTtDZ«DZ*DR«OR) 

IFCSB.EQ.O’.I GO TO 150 
CSB a DZZSB 

SN8 a Dr/SB 

AP a angle of the PERPENDICULAR OR ORTHQGONaL 

AP a '.sOaAPT ♦ , 50 •( AT AN3 ( DR'.'DZ , APT*BDMSL A') sBDMSL A > * PlQ2 

SNP a SIN(AP) 

Csp : COS(AP) 

D a SIN(AB«AP) 

n a snb«6sp-cs8»snp 

IF( AE)S(D) ’.ltV.OD go to 150 
XP a XPT*2BT(L8) 

Tp c Ypt-SBT(LB) 

SS a (YPaCSPoXP»SNP)/0 

^ s SS/SB 

^^{^.^^'.I'.OOOD QO TO 140 
IF(F,gT; (i'.OOOl) ,0B, FQEl) GO TO 2flO 
F ;le;-.oooi 
Go TO 150 

F .ge; I'.oool 

140 FGEl » .true; 

150 continue 


c failed TO f1N6 proper boundary intersection 

APTD a APTaTODEG 

write (6,1950) nAm3DY»XPT»YPT.APTD 

c first or last interval 

LB a lbI 

IF< .NOT.FGEII go to 165 

LB a ib2 

F a . 9 

165 Dz a ZBt{LB*3)-2BT(LB) 

DR » RBT(L8*3»-RBT(LB) 

write (6»i’60) 

200 ANGCHDa A TAN3 ( DR, DZ , ANGB T ( LB > J 
F s AMAXltOiiAMINKFii; )) 

G a 1 ; .F 

YpA a AnGBT(LB)-AnGChD 

YPB a AnGBT(L3*3)-ANGCHD 

RZONLva '.FALSE*. 

Call bfi 

1 ® (LB-LB10*3)/3 

fa s f 

Si a SlM 

xa 8 zbt(Lb)*zm 
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YB = RBTtUBURM 
RZONLYs .true. 

RETURN 

1950 F0RmaT(/iX61HERR0R. The intersection or a l‘.e, or t 
«WITH THE/6X14HB0UNDARY, BDYsA6,40H, WAS NOT. FOUND, 
«POINT IS/6X2HX*Fin.5i3X2HYsF10.5*4X4HANQsF8.3i ) 

1960 F0RmaT(/6X58MThe i^teRSecTion POiNT jS being PlACED 
«RVAL,/6X24HEMECUT10N WRL CONTINUE,) 

End 


E. ORThOqONAL 
the l.e./t;e. 

IN aN ENd I^Th 
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«UECK RBCONV 

Subroutine rBconv 

•RBCONV REBUILD CONVECTEO PRdPERTlES TABLE PRBCOnV* 

collect list of channels from /eONVTB/| THEN BUILD A 
new /convtb/ from channel Data to account for input modifications 

^ABLE of CONVEC^ED PRqPE^TieS 
INDEX^ LTbLTO.LTE 
Ch s ChAnNELNAmE 

ltnext* index Increment to the next channel 
LPSI S relative location or PSI LIST 

NPT s NO. 8F psii TT» PT AND RCU VALUES 

t-TT s relative location OF TT LIST 

LPT s relative location OF PT LIST 

LRCU 8 relative location OF RCu LIST 

COMMON /ChDATA/ ChIDiLTNEXTU I.’NPTfDiLPSi (1 ),lTT(1),LPT(1)»' 

1 LRcym, 

^ CrG<1),CPGJ<1»,C2CPIi>,qGAm‘i),FGT<1),FBP<1>; 

'5 FGRa),AREATBH45> 

integer ch 
dimension XCHdJ 
Equivalence fCHiXcm 

common /IXORIG/ 

ft 
ft 
ft 

dimension 
Common /sltab / 
integer slchn 

common /cFB2 / PaSSI 
LOGICAL PASS! 

COMMON /ERASE2/ ChT ( 500 ) , AT ( 5fl0 ) , FLW ( 500 ) 

Common /spacer/ maxlh»maxlTi’maxlF»maxlw 

integer cht 

accumulate channel names and areas 
•LT 8 lto 

I 8 0 

110 I 3 U1 

CHT( I )8 CH(LT) 

AT ( I > 8 arEATB^LT > 

LTl 8 LT*l.PSI (LT>*NPT(LT)il 

ELWII)8 XCHOiTl) 

LT s Lt*LTNEXT( LT) 

IE^LT.LT.lTE} go TO 110 
Nl 3 I 

cycle through 8C0NV ROUTINE 
PAssi 8 .false; 

LTE 8 LTO-1 

1 B 1 

130 Call bconvicHti i ) , lTi atii n 
check For changed flow rate 

LT a LT*L»SI (LT)*NPT{LT)il 

if(xch(lt) '.es'.flmi n ) go to ito 
update The streamline- Table flow valUeS 

search for FIRST AND LAST ELEMENTS OF SLCHN ( J ) «CHT ( I ) 

DC 140 jAai»NJ 


LHO.LHE, LBDO.LBDE, LTO.LTE, LWO.LWE# LFO.LFEj 
LOiLESTA, lDUM<8>, 

MOiNMi NJ.NFCOLS. MAXN J , mAXOL • M AXNM » MA XlE i 

LEOiLEEi lro.lRe.lrd 

LIMITS(24> 

W(128)iX2tl28j»SLCHN(128) 
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140 ir(StCHN(JA).EQ,CHT(I )) 60 TO 150 

ibQ DO 160 J«JA.NJ 

ir(SLCWN( J); nE.CHT( n ) QO TO 170 
160 J6 B J 

c Scale tme cumulative flow Rate values 

170 DO 180 JSJA.JB 

180 u(j) B Wf J)/W( J0)«XCH(LT) 

C SET PASSlsT TO JU^P AROUND INTERPOLATION FOR VM IN 

C (TyPE*fIELD) 

PASSI = .TRUE'. 

I 9 O I s 1*1 

I iLEiNn So TO 13Q 

IF(lTE.LT'.LWO) go to 980 

WRjTE (6,1966) L'^OiLTE.MAXlT.LWo 

CALL ERRORl 


980 

1960 


Return 

F0RMAT(/iy69H**« THE TABLE Of CONVECTED PROPERTIES 
♦LLOCATED memory /6X4hLT0=I 4,'3x4hLTE»M/ 3x6HMAXlTs I 4 

End 


flobal 


Has exceeded a 

, 3 x 4 HLW 0 PI 4 , ) 
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• DECK RTCn 

Subroutine rtcfi (chti,lh> 

•RTCM- RETftlEvE channel, FLOM INPUT tiRTCFl* 


INPUT- 

chdaTas channel Input data table, 
chti s channel nahe 

uutput- 

LH a index of CHTl IN THE CHANNEL DATA TABLE 
■ 0 IF NO channel DATA WAS FOUND 
IF they exist. THE CHDATAsLlSTS TTiPTiRCU ARE TRANSFERRED TO THE 
LISTS OF TTvPT.RcU; IF THEY DO NOT EXIST, TT,PT,RCU * BITS, 


integer CHTl 


C 


channel INPUT data TABLE 
INDEX- LHaLHO.LHE 

Common /chOAta/ chnam(i) ilhnextii)«wtflow{i»#tto<1)*pto<i» • 

1 TSO(l) ,PSO<1 );MaCHOU) »A0(1J .VARY(1)» 

2 R6<1).GAM(U, NR(1),NC(i),TAB(6I» 

^ BB<75) 

vary 


logical 
integer chnam 
dimension 
real 

equivalence 


VO(l) 

MACHO 
( VO.MACHOI 


COMMON /IXORIG/ 

ft 


DIMENSION 

equivalence 


LHO.LHE, LBDO.LBDE, LTO.LTE. LWO,LWE, LFO.LFe; 
LOiLESTA, LDUMIBI, 

M0»NM. NJ.NFCOLS# MAXNJ, MAXOL • MAXNMi MAXLE i 

LEOiLEEi LR0.LRE»LRD 

LIMITS(24) 

(LlMlTSiLHO) 


Common /crits / 
Common ^erase/ 

dimension 

equivalence 


BlTSiBLANK 

QV< 8) ,EDUM(72) , A<90> iV<90) V 

PSI (90)iR<9o)*TT(90J»PT(90).RCU(90)iPS(90) 

Y(90 ) 

<Y,R> 


namelist /nuCHN / pSi ,R,Y,TT,pr;RCU,pS 

c Search chdaTa fOr chaNnel«chti 

LH a LHO 

60 IFILH.GE.LHEJ GO TO 65 

IF(CHNAM(lH)»EQ'.CHT1) go to 7fl 
LH s LH*LHN£XT(LH) 

Go to 60 

c NO INPUT Table was found 

65 LH ® 0 

RETURN 

c an input table was found 
70 Continue 

c Place fhe table in cOmmOn.eRaSb 

NCR R NC(LH)«NR<LH) 

IF (NCR.GT'O) CALL 1 SORT ( TT »PTiRCUi BB(LH>»NCR) 
Return 



• deck PP1.0T 

0VERLaY(stCi1.4> 

program pplot 

•PPLOT dummy to call PRTPL'T 

Call prtplt 
return 

END 
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*D6CK PRTPLT 

Subroutine pRtplt ■ 

•PRTP1.T PRiMTER PLOT 


CO.^MON /CaiTS / BIJS.BLABK 

CQrtMON /CHDATa/ BDT(l),LBREXTfli;LBZKl),CHNAME(l),UP(l>. 

« LEDEX ( 1 J ;2BT ( i ) .’RBTi 1 ) aBGBf < 3 ) 

DIMENSION Xl(l) iLNEXT<ir*MLB<l)iMuBaj»PRIM(l) »TYPELB<5 )i 

« :■ TYFE-U8('n — 

equivalence (Xl,3 DT), ( LBNEXT ;l^EXT* , (MLB# LBZ i ) , ( MUB»CHNAME J, 

S (PRlM,UP),{T¥PEL8VLEDEX)T(TYPlUB7ANGBT(3n 

common /SlTaB / W(i28),X2fl26J;SLCHNa2§) 

Common /cr / r(30O) ^ 

Common /cm / jhs(300) 

COHMOW7CZ" /"rrjU'O) — — - 

Common /cidex / Mi JOUM,MU iMD.istAG 

Common VI xoRtQ/ lhoiLHe, LbdovlbdEj ltoVltb. lwo#lwe, lfo/lfe, 

X LO.'LESTa, LSO/LSEi LDO.LDE.’ LdUM(4)i 

2 MO;NM,Nj;NFCdLS(l60) - - 

COMMON' 7PRNTP--7‘' 'F(T31,4ffT 

Integer PiPLUS 

Common ^prntpi/ rsvt20),jsv<20) 

Common /prntp2/ lbi»lb2i ti i i » isv» ii» I2i k#kk»ksv»ki»k2i ipiipi* 

1 ' iP2iiP3i‘ Ri, iQo; xmin;xmax;xfact;ymin, ymax, YFACT 


DI.MENSION ITABLEdO) 

c 

logical istgsv 

Integer te - 

Data le,te/2hlei2Hte/ 

Data PLtis/iOR* "■ 

Data mtable^'i ) , Is1i10)/ioho iIohi ,ioh2 

♦ I0*tl3 tlOH4 »XOH5 ■|I0H6 *10^7 

* »i0H8 il0H9 / 

c search For Max and min; set scales 

C YFaOt ANr XFACT CHAR/Um - 

YmAX = R(NM) 

TmI! 1 = R(l) 

XmAX 3 Z(NM) 

XmIN = zil) 

Do ilO I= 2 VNM 

YmAx = AMAXITyI^AXi^TI )T - 

ymiP! a amiNk yMin;r< 1 M 

XmAX a AMAXlfXftAX, Z( I I t 
XmIN s AMINKXMINiZI I ) > 

110 Continue 

YFACT 8 (YMAX"YMIN)/8. 

X F A CT r ( X M A5T^VTl rN )V 1 3 , 

YFACT a aMAXK YPACT.XFACT) 

XFACT = YFACT 

YfACT a 6‘./YFACT 

XFACT 8 iO'./XFaCT - . - 

C INITfALTzE P ARRXY ' 

Call setm(i, blank. p;6288j 


c fill in boundarTes until bdytab exhausted 
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IjB « l'BDQ 

130 IF (LB;Qe:lBDE) So to 200 
tBl = LB+liBZKLB) 

tB2- ® CB'^TlBNEXT (CBT6^ 

I = lNT^(ZBT(LBl)8XMtNi*XFiCT»*l 

K INT<(R8T(UBtl¥VHtNj*?FXcTTTl 

IF niGT'.iSll I«131 

IF <1 lt;i) t=r - 

If (K.GT.48) K=48 

-tF (K’.rT:rrK=i 

F(UKj = PLUS 

Isv = I ■ 

*<SV = K 

• 1,03 = L‘8Tt3 ' ■ 

DO 190 taLB3«l^B2i.3 

I « Ti^t( ZE nrJ'^inmrinfnrc Tt 

K 3 lNT#'(RaT(L)^YMlNi«yPACt)*l 

If (liGTUSi) Isl 31 . ' 

IF m;lt,i) H=1 

IF (K.QT.48y K = 48 - - 

IF (K’.LT.i) K = 1 

P(l£K) s-pCUS^ 

IF nA8S( lilSv) .LE,1) GO TO 150 

c interpolate ■ '• — ■ •"* 

II 3 MlNOdilSV) 

1 2 3 MAXOd i l SV) 

I i ^11 

14 0 Ip s-l-fi-T ■ 

If ni.EQ;i2f GO TO 180 

kk 3 K-dK-Ksvi^d-in/nyisviT ~ 

P(M|KK) S PL'uS 

So To 140 • 

150 IF n ABS(KiK8V) .LE.l) GO TO 180 

u ^ wPiTcrtrs'^ ) 

I 2 3 MAX0( I I ISV) 

Ki ; MiNO(KVKSV)- - 

K2 a mAXO(K.KSV) 

KSV 3 {K2-KP)/2 *'K1 

DO 160 KK = Kl»eKSV 

160 P { 1 1 , K K'I—s^FCDS" 

KSV = KSV *1 

170 P(I2»KK) = PUUS 

180 ISV = I 

^ KSV 3 K 

190 Continue 

Lb -s rB^liBNEKTCCBT ' ' “ 

Go to 130 

200 Continue 


c add ql TO Plot ■ ~ ■ ' 

300 Ls 3 Lo 

305 If aS.QT'.LESTA) GO TO 500 

Ip 3 xiois) 

IPI = IP 

;lF (IP.UT'.IOI GO TO 320 
- • - t r MP ; LT'.Tm' SCTTO-Tro ■ - 
Ip3 = iPl/100 

IPI = IP1*IP3»100 

Ip3 = itABLEI IP3+1) 

310 Ip 2 = IPI^IO 



Ipl. a iPl,iP2*ia 

irz B itablE(1p2*i) 

320 IPi * iTABLE(IPl*l) 

Ur e’-HL’B’ltS-J 

L3 = MU9|lS) 

I B iNT|(Z(tl)^XMiN)itXFACtUi 

K a INTl(R(LlNyMIN)«YFACTUj 

IQQ a i 

Go TO 400 

330-trl — - 

Ir <Ui’.QT.L2) Go TO 380 
ISV a I 

KSV a K 

I a lNT#<Z<£il)«XMlNrfXrACrTi*l 

K B INTf<R(Ll);YMIN)#VFACTUl 

TSO"~ = ■■? T' 

Go TO 400 

350 ir MaBS(k;kSV> <LE.I) GO TO 330' 

Ki 3 MiN0(K,KSV) 

* maxq(k;ksv) 

II ^ ISV 

ir rKi;Eo:T?T~Tr»T 

I 2 e isv 

ir tK2,EQ'.K>f2Bl 
I a il 

K a Kl 

IGO =3 

360 k ■ 

I a II t fuOaT{ n2-ii)*<K«ki) )/ruoAT(Ka-Ki) 

IF IK;gE.K2) go to 330 
Go lO 400 

380 LS a LS*1]MEXT(LS) 

Go TO 305 

400 p-f I tK) 3 ipt- 

IF Up, ge;io ;an!5. i,gt;i) P(t*i,*K)aiP2 
IF UP.Ge'.IOO '.and. r;GT;t')'P^i;2,K>siP3 
Go To (330;3J0.360) ,’IGO 


C ADD Si-'TO- PLOT- - 

c locate first PT on 9L 

500 J - 0 

510 J 3 J+1 

IF IJ'.GT.nJ) GO TO 800 
N a MBEGIN(J) 

isTGsv - irALsr. ; — : — - — 

C SAVE COORDS OF Sl SEGMENT 

520 L a 1 

530 RSV<L) a rTMI 
ZSV(L) i Z(M> 

Call 6€trx — -- 

IF (ISTAG'.NE?!) go to 534 • 

LR 5 0 

Caul stano(MwlR,uppeR> 

If ITYPELB(L'R);EQ.LE ,0R; TYPEUB(LRi,EO,LE) GO TO 550 
534 IF (MD'.Eq'.O '.'and. ISTGSV) GO TO 550 

IF (hd;eo:t) isirto'Bio 

If (ISTAG'.NEVb) go to 538 
UR a 0 

Call stanocm^lR. upper) 

If VTYPELBICR) ’.EO.TE ,0R, TYPEUBtUR) .EQ7TE) GO TO 540 
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538 M = MD 

U = L ♦ 1 

GO TO 530 

540 rsTQSV B- - 

RSV(l) 5 R(M» 
ZSVd) a Z(Ml 
L 3 2 

M 3 MD 

Go TO 530 


C determine X2 

550 LTOT = i: - 

IP 3 x2(3) 

I Pi = IP 

IdJGIT si 

TP { 1 p . t"Ttri3i'njTrTO'“!rT(j 

Ip (IP.LT'.IOO) go to 560 

I DIGIT 3 3 

Ip3 3 ipi/ioo 

ipi s iPi$ip3noo - - 

IP3 3 itAflLEl IP3*1) 

56 0 I Ol G I t'"4T "2 

Ip2 3 ipiiio 

I pi s ipii-iP24ia - - — 

Ip2 s i7A0LE( 1P2*1) 

570 I PI a itABLEnPl*!)- 

610 I a 

|< s INTl(RSV(l)-YjUNj«YFACf )♦! 

IqO = 1 . 

Go TO 700 

620 L 3 L+1 

Tr 1 L ; LE -. CtOtT" G 0 *T O' 63 0 

Ip (MD.EQ'.O) GO To 510 

M P MD' 

Gq TO 520 

630 ISV a I - 

KSV a K 

•I ■' = rNTTcrsvaT-WPii-vxniiTrTj^i" ~ 

K = INTI (RSV(L)^YMlNi«VPACt)'4l 

IqO =2 

Gq TO 700 

C INTERPOLATE (aSSUmE ISV.lT,!-) 

640 I r- 1 1 ^ I SV 1 L E^TDTGTTT - G0 - T8 ~S 2D 

KK 3 K 

M = I - 

I ISV 

650 I s I *tDlGlT 

K 3 kK - PL0aT{ (KK.KSVjBniiin/f'L-OATl II-ISV) 

IF <1 ' Ge'.Ttr'GcrTo~52tn 

IGO 3 3 

Go To 700 
700 P(UK) 3 jpi 

Ip Mp.Ge;iO .and. I,GT,U P(i-1|K) = IP2 
If TlP.GE.10Tr^;7mDV'nffT-.T)- Prf92rKJsTP3 
Go lO (6207640 •630), IGO 


800 Write ( 6 ,iooo) 
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Do 9lo KK5li48 

K s 49-KI< ' ■ " 

"^RlTE <6;i00j;) (P(I,K),I?il,i31'> 

8io Continue - 

900. Return 

1000 roNMAT (lH1.35Xa6HXIl,XI2 QRtD MAP //) 
XOOl ToRmAT ((lx;t31A*)> 

Enu 



•DECK STC8 

OVERt Ar(STC,2,0 J 
PROGRAM STCB 

common /chNTRT'' lCHN(10),WTrSfl0)»WTFA(l0),WPTO(10)fWTTO<l0|; IC 

common /select/ lestry 
Go TO (10.'20^10i10)iLENTRY 

C normal entry-* station loop, flow balance 

It’ Call OVERLAY(3HSTc,2,l,6HRECALLi 
Go TO 30 

20 Call 0VERLAY(3HSTC|2,2,6HRECALLJ 

>50 return 
end 
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«LOCK UATA CrbOL*' 

•CFB--* BLOCK DATA FOR CFB 

COMMON /CFB / L , M A , MB , PLB .’PUB.'WF , CHOKE . SUBSON . 
1 XCHOKE, TAREA.VMBCi WRQSTiWCALCi 

* JSUMiVMLBSQ 

logical choke. subson 

Data xchoke/Shchoke/. jsum/o/ 
end 


• CFB» 

NK.PLBC.PUBC, 
QV(8) »QVP{8| , 
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*UECK ERRORX 

Subroutine e^rori 

CEOUMPX EDUHP FOR STC EXfiCUTC SECTION PEDUMpX* 


logical iplot 

COMMON ^CMDATA^ T ABLES ( t ) , LNE J(T 1 1 ) i MLB ( 1 ) , MUB ( 97 ) 

Common /allcom/ macma(20) 

Common /cb / B(300) 

COMMON /CCURV / CURVI300) 

COMMON /cnS2 / DS2(300) 

COMMON /CEDUMP/ IGODMP 

COMMON /CFB f L i OCa ( 4 ) , fB ,‘DFBl ( 2 ) , NK , DFB2 ( 7 ) , N I C , DFB3< 17 ) 

Common /cidex / m, j# mu»md» istkg 
COMMON /CLINES/ L I NE S , OM I TFK , PT ! TLE ( 6 ) 

LOGICAL OMITFK 

COMMON /CM / JMS(300) 

Common /cphii / phik300) 

COMMON /CPLOTI/ PLOT , SaMeXY(13 ) 

LOGICAL PLOT 

Common /cr / R(3oO) 

Common /crhs / rhs(300) 

COMMON /CSI / Sl(300) 

COMMON /CS2 / S2(30CJ) 

COMMON /CTA9PR/ UTAB 
COMMON /CVM / VM(300) 

Common /cz / Z(300) 

COMMON /ERASE 2/ ARE A ( 96 ) , AREAO ( 96 » i D 1 SP (96 > , PT ( 96 ) , L AMBDA ( 96 » , 
« RH0<96) ,SQRTVV<96 ) iTS(96> iTT( 96) # VMSQ(96)i 

« VVKQKP(96), 

« WqA(96),WSTA(96)* RG ( ’6 ) , C2CP (96 > » FGR ( 96 ) 

REAL LA'IBDA 

dimension ES2(96) ,SDN0RH(96) 

equivalence (ES2» VVKQKP) . fSONQRM»RHO> 

DIMENSION RCL)(96) 

equivalence (RCUiLAMBDA) 

COMMON /IXORIG/ LHO.LHE, LBD0,LBDE, LTO.LTE, LW0,LWE, LFOiLPE, 

Ln,LESTA,LSOiLSE.LDUM(6) , 

4 MOfNMi NjiNFCOLS* MAXN J , MAXOL • MAXNM i M AXLE » 

A LeO.LEEi lro,lrb,lrd 

COMMON /SLTAB / W < 12 8 > # X2 ( 128 J . 8LCHN ( 128 > 

integer slchn 

COMMON /BLBD¥ / IrLB<60) 

IPLOT s plot 


LMAX s 0 
130 write (6,1130) 

call TA8pRT(3H •L»34#8) 

WRITE (6,1150) (J,X2{ J),SLCHN(J),W(J)iJs 1,NJ> 
IF (LMAX) 180,140,180 
i'*o Call tabprt(6hallcom,macha,20.8> 
call TABPRT(9hCIDEX,M,5,5» 

Call tabprt(6HIxorig,lho,i 2;2I 
IlTAB a LBDO 

Call tabprt(6Hbqvtab,tables;lbde,3) 

IlTAB a lTO 

Call tabprt{6hconvtb,tables,lteV7> 

IlTAB a LWO 

Call tabprT(6HwaKetb, tables;lme;2) 

IlTAB = LFO 

call TABPRt{6RCADjMF,TABLES;LFE;8) 

IlTAB = LO 
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Call T^BPRT(AHSTATAB, tables. 'L 6StAi5> 


c 


FlfcLD table dump 

L S LO 

LMAX a LESTA, 

IBO OMITEkb .true. 

LINES s 64 
190 Ma ® MLB(W) 

MB s MUB(L) 

CALL rHEAD(M8-MA*2) , ^ 

If (LINES'.EQ';<MaiMA*5) ) WRITE (6.1200) 

write U.1202) 

Do 200 M8MA.HB 


WRITE (6,1201) J.M.MiJ.MD, ISTAQ. S1{M)»S2(M) 
& CURV(M) iVM(M) »B(M) •RHS(M) *DS2(M> 

200 CONTINUE 

L s L^LNEXTtL) 

IF(L.LE;lMAX1 go TO 190 
L a LMAX 


;z{m>.R(m>,phi1(M) 




c EWASE 2 Dump 

300 write (6,1004) 

NIC a M1N0(N1 Ci128) 

NK 3 M1N0(NK,96) ^ ^ 

Go TO (9 ooV310.330i350.360.37o.390)» IGODMP 
C FL08AL 

310 write (6,1000) 

DO 315 lal.NK 

WRITE (6,1001) (AREA(J) I J?1 ,672,96) 

315 continue 

write (6,1002) 

Do 320 lai.NK 
IP s 672*ti 

WRITE (6,1001) ( AREA( J) , Jf IP, 1536,96) 

320 continue 
GO TO 900 

330 WRITE (6,1005) 

DO 335 1»1;nTC 

WRITE (6,101?) (AREA(J),J?I, 768,128) 

335 Continue 

WRITE (6,1005) 

DO 340 ISIVNM 
IP X 768*f 

write (6,1006) (ArEA(J)iJ? IP*1544i96) 

340 continue 
GO TO 900 

350 write (6, 1007) ( AREA ( I ) » I»ll52, 1183) 

write (6,100?> 

Do 355 Isi.'NiC . . 

WRITE (6,i0l0) (AREA( J) ,U?I ,1152,128) 

355 Continue 
G o to 900 


360 write (6^1011) { ArEA( I ), 191026,1037) 

write (6,1012) 

DO 365 UiVlB ^ ^ 

365 write (6, 1013) ( ARE A( J >» J9I , 1024 , 128 ) 
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Go TO 900 


370 WRITE (6,1014) 

DO 375 lal.'MK 

WRITE (6,1001) (AR£A( J) , ji I ,'4S1;48| 
37b Continue 

write (6,1015) 

DO 380 I=i;NK 

WRITE (6,1001) (AREA( J) , Jf432;8d3»48) 

360 Continue 

GO TO 90q 


390 write (6;i0l«) 
DO 392 lalVSfl 

write (6,1001) 

<s 

& 

392 Continue 

WRITE (6,1017) 
write (6iioi8) 
900 continue 


AREA( 1 ) , AREA( I *128) | AREA( 1*256) , 
AREA{ 1*50) «AREA( 1*178) i A reA{ 1*306) i 
area ( I *100), area (1*228 ), area ( 1*356) 

(AREA(I), Ia3S5,'696) 

( ArEA( I ) I I»897*1308) 


^E{ IbL0(1) ;Re;0 ) call TaBPRTISHBUbDY, 1bLBi60,3> 
IE ( LDE.Eq'.O ) QO TO 1321 
IITaB s LDO 

Call tabprt(Shbltab,chnam,lde;3) 

1321 continue 


LSTOP a 5 

GO TO (999.999) , LSTOP 

*’99 return 


Entry edumpi 

LMAX a L 
IPLOT a .fAL'SeI 
GO TO 130 


1000 Format 
& 

& 

1001 Format 

1002 FORMAT 

8 . 

format 

a 

1004 FORMAT 
10D5 format 
& 

1006 FORMAT 

1007 Format 

1009 format 
a 

1010 Format 

1011 Format 
a 

1012 format 
a 

1013 format 

1014 format 
a 

1015 Format 


(//2Xa47HSU3R0UriNES ABJyF, BRHS, FlOBAl, WRIBDY, WrIqUT// 
11X,4HARBA,8X,5HAREAO,9)(,4HDISP;i1X’;2HPT,7X,6HLAMBDA,10X, 
3hRW0.7|(,6hSQRTVV) 

<2X*’El3.5) 


(//13X,2hTS,11X.2HTT;9X,4HVMSO,7X,6HVVKoKP,10X,3HWQAi9Xi 

4HWSTA.11X,2HRG,9X,4HC2(;P,10X.3HFGR) 

(//2x»i1/hSUBR 0UTINE PTMOVE// l*X,l5NXlLfllX»2HSC»10X,3HSCXi 
llXi2HLC.8X.5HLQOPC;i(jX';3HKCL> 

<1HD 


(//llX,4NPHl2,10x,3HDSl,ilX,2HZK,llX.'2HRK,2x,5HWBZPT| 

9x.'^HDSiC) 

(2X;4613;5,5X,L2|E13'.5} 

I//2Xfcl7HSiJ3R0UTlNE REF InE// 2X , 3WI Aa, i61 7/2X # 3HI B?# l6l 7 ) 
(//13X,2 wcR. 9X, 4HDELS.8X;5HDELVM,2X,4HLSTA#3X,3HMj2,lflx, 
3HSSX.lOX,3HsGy,iox;3RRAV.10Xi3HZAV) 
l2X,3Bl3;5,216.4El3;5) 

(//2Xv14hSU 3R0UTINE SLC//2X , AHCURSSa . 6E13 , 5/ 

2X*6H0V a.8El3,5) 

(//l3X,2wRB,llX,2HZB;i0X;3HANG,8x.5HCURVB,10X*3HSlB,liXi 

2HB1v2X,6HJ2D0NE,3X;3MM9V) 

(2X.6E13.3,2X#2I6) 

I//2Xal4MSUaR0UTlNE OLC//13X , 2 HZk . llX , 2 hRK . 8X iSHWEZPl; 
9X,4HPHI2,11X,2HC2,11X.2HSP,10X,3HSPPi10Xi3HGSP,9X,4HGSPP) 
(//l3X.2HDS»10X.3HBET»10X#3HDDSi9Xi4HWSTA#9x#4HDISPf 11 X» 
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iniA rnoMAT ,2 HTTxHX, 2HK1 ,yx,4HC2C^',10J^,4M^aKl 
1016 FORMAT < / /2X»26MSU9R0UT I NES AODrTB, PU0TRZ//11X , AHANGB . ilX . 2HRB, 


« 11X.2RZB) 

‘/2X.1hRR/(2X,10E13;5)») 
loiB Format (/2x.anzz/(2x,ioEi3l9) . > 

<2Xi3Ei3;5,3I13) 

• 2^»’^1"'-*”A,Mb,3X,25H4-PLB,PUB, WF,ChOKE|SUBSON, 

«3X,4AH9-NK,Pli8C,PU8C,XCH0Ke;TARBAiVHBC,WRQST,WCALC, 

5X|32h 1'-0V<®> *QVP(a> 33-jSUMi VMLBSOX) 
iisn*rnou.T ^7-0Vi8),QvP(8) 33- JSUN» VMLBSQ* ) 

llbO format (///1X17HSTREAML I Ne T aBLE;/17X32H J X2 SUCHN 

1200 FoRMAT(57x.l6Hrf6L0 TABLE DuMP/ 128H J M MU MD I Si 
^2 Z • R PHII cURV 

1^01 n • * DS2) 

1202 ^^'^^^^•**2^12,6,fii,6,pi2.7.2F11.3,2F10;5) 

end 


MD 

CURV 
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onnnci rjcjooocjrjooocioonooo 


•DECK ADJWF2 

subroutine ADJWF2 

•ADJWF2 insert choke STATION IN FLOW ADJ-TABLE #ADJWF2# 

C C0MB3 

c cadjwf, CHDATA* STATAB 

COMMON /CHOATa/ CHN AMI 1 J , LHNEXT f 1 V iWTFLOW <1 ) , TTOU ) iPT0< I J , 

TSO(l) iPSOlDtHACHOll) I A0(1)<VARY(5) iTAB(6) 

integer ChNaM 

LOGICAL VARY 

flow adjustmest table 
Index- LFsiro/Lre 
NFCOLSs 8 

XlF f ORTHOGONAL COORDINATE 

X2F streamline COORDINATE Of SL EMINATING FROM T,E, 

XIbF s XILcOORdINATE OF CHOKE STATION OF FLOW BELOW TjE, 

XlAF ■ X1»C00RDINATE OF CHOKC STATJON OF FLOW ABOVE TiE* 

SlF B SliCOOROlNATE OF T;e. (UPPER SURFACE); THIS ITEM 

IS USED when INTERPOLATiNQ FOR WAKE DELTA-STAR', 
LFBiLFAbINDICES of STATIONS BELOW AND ABOVE T;e; 

NCHBiNCHAsNUHBER or channels below and above T,Ei 
lrf c Index of dummy ortchn list for the t.e. 

LRXF n index of LAST CHANNEL BELOW THE TiE*. 

JORDERb 0 IF TOTAL FLOW AT Xlf IS GIVEN 
a 2 IF FLOW ABOVE T.El IS GIVEN 
B 1 IF FLOW BELOW T.El IS GIVEN 
JORDERb ;i IF FLOW AT XlF IS CHOKED AND SINGLE CHANNEL 
dimension XlFU) ,X2r<i)tXlBF<l)»XlAr<l) , 

1 SlFa)|NCHBahNCHAU>iJORDER(l)i VNR(12I 

equivalence (LFB,Xi 8F» , (LFAVXIAF) i (LR^|NCHB) , (LRXF.NCH aI 
DIMENSION LF3<1) ,UFA(i)*LRFa) ,LRXF(1) 

station Table 
Index- lslOiLESta 

SCHOKEb STATION CHOKE INDICATOR ( ADJWF ,BRHS iWR lOUT ) 

MCL b SHARP CORNER INDICATOR (BUPTBS) 

ncl s FIEL0 Index of control streamline (ptmovEiflobau 

Dimension xku *lnextcU 'HLBd) *muB(1) »prim(D •' 

1 TYPELB<l).NAMeLB(ll,ILB(i),FLB(l>,SlLB(i)i 

1 TyPEUB(l) .NAMBUB(l)iIUB(l},FUB(l) iSlUB(l) I 

^ VM3( 1) ,OWOV(lJ . x2CL11» iSLSWl(l) .HCL<1> • 

« AnGTE(I) tPTTEdl *PSTE(1) iFQRTEd) *RGTE(l)i 

<S ANGEXP<l),BSOeXP(475) 

dimension CRVLEdl.ANQLEdJ 

equivalence ISCHOKEiDHDV)*(CRVLE»ANQTEJ. (ANGLEiPTTE) 
integer RRlMiTYPELB.’TtPeUBiSCHOKEdI 

equivalence (C^<NAM,X1F,XIJ. (LHNEXT,X*F,UNEXT) 
equivalence <WTrL0W,X18F,MUB»; < TTO, XlAF , HUB > , IPTO.SlF.PRlM I 

equivalence (TS0|NCHB»TYPELB>; <PS0|NCHA|NAMELB) 

equivalence (macho. JOROERVILB) • ( AOiVNRiFLB) . (VARYdJ iSlLBI 
equivalence (VARY(2),TYPEU8I, ( VARY ( 3 ) , NAMEUB ) i (VARYM).lUB) 
equivalence (VARY( 5> ,FU8) 

equivalence (TA3(l),AREATBiSlUB|i ( TAB (2 )l, VMS ) • < TAB! 3 ) , DWDV I 
equivalence (TA9(4)iX 2CL)* ITAB<5)iSL9Wl)*(TAB<6)iMCL> 

common /CFB / L,MA,MB,PLB;P08;wF,CH 0KB,SUBS0N. NKiPLBC.PUBCi 

1 XCHOKE, TAREA,VmBC, WRQST.WCALC. QV ( 8 ) , QVP ( 8 ) i 

* JSUMtVMLBSQ 

LOGICAL CHOKB.SUBSON 

COMMON /css / SSFML,SSEF,SS6ANG,SSDF,SSrEND,SSFNDl 
1 .SSDLE. A^FACTiBRLXiCURRLX 

integer SSFML 

LOGICAL SSEF, SSDF. SSDLE 
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norjooonrjnr: 


SSFML s 
SSEF B 
SSEANQs 
SSDF B 
SSFENDs 
SSFNDla 
SSDLE r 
A4FACT* 
0RLX B 
CURRLXs 
COMMON 


supersonic curvature rORMUlA number 
supersonic entering flow* t or f 
entering flow angle (Begrees) For ssef.t 
Supersonic discharge flow* t or r 

downstream end condition* «o«i for parabol 
supersonic beam upstream end condition; for parabola 
ss flow below and aft of le pt, t or f 
central point influence coefficient factor 
B-RELAXATION factor 
CURVATURE RELAXATION FACTOR 

/iXORtG/ LHOiLHEi LBOOiLiDEi LT0,LTE.’ LH0*LWE* LFOiLFE# 
LOiLESTA, LDUMI8T* 

MO.NM, NJ.NFCOLS. MAXNJ,MAX0L,MAXNM,MAXLE, 

LEOiLEEi LR0*L’RE*LRD 
LIMI TS(24) 

(LIMITS*LH0> 

W( 128 ),X 2 I 128 j,sLCHNa 2 a> 


dimension 
Equivalence 
Common /slTab / 
integer slchn 


COMMON /CIDEX / M, J, MU,MD* ISTAG 

check For smaller previously dectected area 

” 4 MLB<^L ) 

Call getix 

JA e j 

^ “ MUBIL ) 

call GETIx 

JB a J 

JSUML a JA*256 »jB 

if< jSum;ne'. jSuml ) go to 90 
IF(TAREA.gT;SVAREa) return 

’0 JSUM 3 JSUML 
SVAREAs TaREA 
IF(SSDF) SUBSONb’.FALSE, 


c 


105 


IID 

115 


SEaRcH fORWaRO to trailing edge 

LX = l 
LSTE 3 0 


IF( .NOT.PrIMKX) ) GO TO 110 
^ 3 ML0{Lx) 

Call getix 

IF(J,NE;ja) $0 TO 115 
* MuB(LX) 

call getix 

if(j,neJjb) So to ii5 


LSTE 3 LX 

U a LX+LNEXTCLX) 

‘fjLx.lt.lesta) QO to 105 
IF'LSTE.Eo'.OI go to 800 


^EaCH CADJWF.TaBLE for t.e. value or Xl 

LF = LFO 

120 iFILF.GElLfE) GO TO 200 

,iF(X 1F(LF) .EQ.XiaSTE) ) GO TO 125 

Lf a Lf*NfcOLS 

GO TO 120 


f 


c 

c 


IS The LeORtwOQONAL BELOW OR ABOVE ThE BODY 
(BELOW the BODY) 
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IF(X2( JA) ’.EQ':x2r(L^) ) XlAr(Lfi*Xl<U 
RETURN 

c choked channel w /0 t;e.i add a line to /cadjwf/ 

200 LF s LFE*1 

IF(lF .NE.lO) go to 205 
nmove = lo;lesta-i 

LO ■ LO*NrcOL'S 

CALL MOVEdi XKLF) ,X1<L0) ,NM0VE»1» 
call SETMdiQ. XlF(Ln INFCOLS} 

L = L*NrCOLS 
LSTE s LSTE+NFCQLS 
LESTA a LESTA^NFCOLS 
LFE a LFE*NFC0LS 
205 XiF (LF )bxi(L9tE) 

X2F (Lf )8X2UA) 

xiaf(lf)=xi(l) 

XlBF(LF)aXlFiLF) 

J0RDER(LF)s-1 

c write comment 

800 write <6,1800) XKDiL 

1800 FORMAT</lx32dUNEXPECTED CHOKE, STAY I ON ( X 1 1 > *F6 3 , 4X2 hL? M , J 
iFCLSTEiEo'.O J CALL ERRORl 
RETURN 

End 
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orjcirici oooncjorjcjnci noocjoci ooooooooo 


•DECK FLObAL 

Subroutine flobal 

• FLOBAL fLOM BALaVCE ROUTINE «*FLOBaL* 


c 

c 


Integration of the continuity and normal momentum eQUaTjons 
along the orthogonals to the streamlines 

INPUT- 

>- * INDEX IN THE STATION TABLE 

^LB s lower boundary STaTiC PRESSURE IF KNOWN, 

Pub s upper boundary static pressure if known! 

(EITHER Pl 3 OR PUB OR SaTH MUST BE ZERO* 

IF PLB (OR PU0) S5i; NO ITERATION FOR FLOW OR 

lower boundary pressure is performed.) 

WF = Flow rate if known (overrides value of wsta) 

Choke = t for calculation of Max flow . 

S2(M) 5 distance along THE ORTHOGONDL 
CuRV(M)sstREAML1NE CURVATURE 
STATION table 

Vm8(L)i: estimated VELOCITY ON ThE UPPER BOUNDARY 

nWDV(L)sDERlVATIVE OF THE AREA INVERSE WITH RESPECT TO BOUNDARY VE 

Streamline table 
output^ 

PlBC 5 calculated lower boundary pressure, MsMA 
PUBC a calculated UPPER BOUNDARY PRESSURE, MaMB 
TAREA s TOTAL PASSAGE AREA FOR ALL STREAMTUBES 
WCALC s calculated FLOW 
WrqsT a requested FLOW (SLTa6 DATA) 

VmBC a CALCULATED VELOCITY ON THE UPPER BqnnDARY 
DwDV(L)5DERIVATIVE of THE AREA INVERSE WITH RESPECT TO BOUNDARY VE 
VCL(L)8 velocity on the CONTROL STREAMLINE 

pL8*PuBao. Preset for next entry) 


station Table 
Index* LaLOiUESTA 

SCHOKEa station CHOKE INDICATOR ( ADJWF , bRHS ,'WR I OUT > 

mcl a Sharp corner indicator (Bldtbs) 

MCl a FIELD Index op control streamline (PTMOVEiFLOBAlI 

Common /chdata/ xki ) ilnextu J »mlb<i) imubu) iPrimid* 


dimension 

equivalence 

integer 


TyPELB(1),NaMELB(1), I 
TYPEUB<D,NAMEUB<lKr 


• II-B(l),FLB(l)f SlLB(i)i 

_ ,IUB(l>,FUB(l>,SlUB<ll, 

VMB( 1) iDWDV(l) iX2CHl) iSLSWI(l) iMCUl) i 
ANGTEaifPTTEfl) iPSTEd) ,FGRTE(1) »RGTE(i) I 
ANGEXP(l),BSQ6XP(475) 

CRVLE<1> ,ANGLE<i> 

(SCHOKE,DBDV),'(CRVLE»ANGTE),( angle, PTTE) 
PRlMiTYPELB.'TtPEUBiSCHOKECl) 


Common /allcom/ 

& 

a 


REAL 

LOGICAL 

Common /cb / 
common /cbIts / 
Common /ccurv / 
Common ''ceduhp^ 
Common /cfb '' 

& 


macha,psa.tsa;pta,tta, axiaVrga.gama; 
MACHC,PSC.TSC;PtC,TTC,' AXIC.'RGC.GAMC, 

daxit,scalea,tte.chotst 

macha»machc 

AXIA, AXIC,CHOTST 
B(300) 

BITS, BLANK 
CURV<300) 

IGODMP 

l,ma,mb,plb;pub;wf,choke,subson, nk,plbc,pubc, 

XCHOKE, TAREA. VmBC, WRQST, WCALC, QV ( 8 ) , QVP ( 8 ) , 
JSUM# VMLBSQ 
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Oo On Qc 


integer xchoke 

logical CHOKB.SUBSON 

DIMENSION Slat A) ,vlB<4) ^ 

equivalence (SIBiQV) • IViB*QV{5) ) 

COMMON /CFB2 / PaSSI 

logical passi 

COMMON /CFRflN/ AT 1 NT , M I NF , RFF I NF , U 1 NF , ZDNl .'ZDN25 
common /CFRFLD/ NFF( 130) ,lDN(50i »UDN(25J 

COMMON /ClOEX / M, J, MU, MD, IsTAG , , 

COMMON /CIDEXR/ M4,CI1U),M3»CI2<4),M5»CI3(4),M2iCM<4),M6,C15(A) 
COMMON ''CISBOT/ C1SDJM(4),ipRES(2)iPSPISViNZPi 
& ZP(IO) |PSP(10»*NZP1 

integer PS=1SV 

common /CIVP / lV?,VPDUM,NRF<2j.INR<2);x.lVP<2),MXLRLX 
COMMON /CLSPF / IiLEND 

logical lend 

COMMON /CMAXlT/ M A XREF , NREF I N , GREF I N , TL 
COMMON /CPI / PI iTNOPI ,P1q2.piq4,T0DEQ,T0RAD 
COMMON /CPRINT/ PRTES2( 6) ,pqUH(20) 

Common /cptmOv/ velpdt * i cob.nodensiFBastg 
COMMON /cQIREM/ YTOL, yO, DyDx.CTRMaX 
COMMON /CR / R<3O0) 

COMMON /CSl / SK 300 ) 

COMMON /CS2 / SP(300) 

COMMON /CTABPR/ UTAB 
Common /cvm / vm(3oo> 

COMMON /cz / Z(300) 

Common /ERASEZ/ ARSA<96)iAREAQ(96)»DISP(96).PT(96>iLAMBDA(96)i 
Rh0(96),SQRTVV(96)»TS(96) »TT(96)i VMSQ(96)| 
VVKQKP(96), 

WQA( 96) ,WSTA(96) , RG( 96) , C2CP ( 96) ,FGR(96) 

REAL LAMBDA 

DIMENSION ES2(96) iSDNQRM<96J 

EQUIVALENCE ( E S2 , V VKQKP ) , I SDNQRM , RHO ) 

dimension RCU(96) 

EQUIVALENCE (RCU, LAMBDA) 

DIMENSION RLAMDA(96) 

EQUIVALENCE ( RL AMD A i AREA ) 

COMMON /IXORIG/ LHOiLHEi LBDO#LBDEi LTOiLTE. LW0»LWE» LFOiLFEi 
& L0,LESTA,LS0.LSB,LDUM(6) , 

« MO.NM, NJ.NFCOLS, M AXN J , M AXOL , M AXNM i MAXLE i 

S LEOiLEE. LR0»LRB.LRD 

COMMON /SLTAB / Wa2B) ,X2(128J ,SLCHN(128) 

INTEGER ■ SLCHN 

COMMON /SLTA82/ PTR(120) 

integer farfld,free;pres,field,soliu,te 

logical wake 


Data FARFLD/6HFARFLD/i FREE/^HFREE/» PReS/4HPReS/i FIeLD/ShFIELD/ 
Data S0LID/5HS0lID/i TE/2HTE/ 

IGOdMPs 2 

500 Ma s MLB(L) 

MB S MUB(L) 

IF(l.EQ.lO) call SETM(1»1.* PTR.NJ) 
c check for hard stag PT (ISTAQsS at pt next to BDY) 

M = MA 

Call getix 
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IFdSTAGii) 510,503,510 
5U3 M s HA*1 

Call geTjx 

IrnSTAGs3> 510,305,510 
5o^ MA s M 

510 M s MB 

irnSTAoil) 320,513,520 
513 M = mB-1 

Caul gETix 

lFnSTAGi3* 520,515,520 
5i5 MB s M 

C ttUiLD TABLF of flow function AND STAGNATION CONDlTJONS 

520 clu TmCMA.MB- WSTA.DlSP.WAKEVTT.PT, lambda, RG,C2CP.FQR> 

C check for olc option 

If'i(IlSW1 (L ) *NE • 0* ,AND, SLSM I CL » • NE . I « ) MOMEQ»0 

C PASSAGE area and SHOCK PRESSURE LOSS 
K s 1 

M s MA 

522 RLAMDA(K)aLAHBDAU) * 

!F( AXI A) rlAMOA(K)sTWOPI»R(M)«LAMBuA(K) 

CALL GETlx 

PT(K) s PT(KJ*PTR<J) 

K * K*1 

M a M*1 

• IF(M,LE;MB) go to 522 
AREAO(l)aoi 
Nk e 

'iF(SlS?(2l‘Ni^;. .0". 01SP|NK=2.-.N6.0;I l-END» ■ T WE . 

call LSPFIT(S2(MA) iRLAMDA,NK, S2(MA) » AREAQ»NK, 

TAREA = AREAO^NK* 

c integrate curvature with Respect to s 2 
c initial Estimate of meridional velocity squared 

C All LSPF 1 T ( 92 ( mA ) ♦ CURV ( MA ) » NK • S2(MA) iSDNQRM*NK* iJ 

UeNd s .FaLSe’, 

M a MA*1 

VVKQKP(K»r>aEXP(2,»(SDNQRM(K)«SONOPM(K-l) >) « TT<K^U/TT<K) 

SQRTVV(Kel)aSORTe VVKQKP(K*1) ) 

VMSQ(K-l)sVMCM-^l)*VM(M9l) 

525 M a M*! 

VMSO(NK)*VMB(L)aVM3(L> 

IF<MCmEO.NE‘.0> go to 529 

VmSQ(NK)sVM(NK)»VM(NK) 

GO TO 650 
529 continue 


SPECIFIED STATIC PRESSURE AND SPECIAL BOUNDARY OPTIONS 
VMLBSoa 0 

IF(NODENs!gE7NREF!N) go to 580 
PRESSURE lower BOUNDARY 
1F(PLB‘,RT'.0'. ). GO TO 530 
IF(TYPELB(L) ‘NE'PRES) go to 532 


lower BDY 
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530 


1«ET s 0 
PSB * PLB 
PTB s PT(1) 

BDYNM s NAMEU0(L) 

ZBPT = Z(MAJ 
CFGT a l./{l.*FGP(l) ) 

CPCPTTa C2CP(1)»TT(1) 

5306 IF(PSB;Gt;0. 1 GO TO 5314 

IF(BPyNM;nE'.IPRES(1)) go to ssid 
I lZP = 1 
l2ZP = N7P 

If(Nzpi;ne:o} l2ZPsNZPl 

Go TO 5311 

5310 iizp s NZPlTl 
12ZP a NZP 

5311 If(ZBPT;ge‘,ZP( IlZP) .AND, ZP(I22 P^;GE,ZBPt) GO TO 5313 
IF< IRET'.EO'.OI GO TO 5312 

TYPEUB(L)rSOilD 
Go TO 570 

5312 TYPELB(L)aSOLrD 
GO TO 540 

5313 CALL LSPF1T(ZP( IlZP)#PSP<IlZPJ.t2ZP-IlZP*l, ZBpT,PSB*li 0) 
IF(PSPISV) 5816 ,5314 |5316 

5314 1F(PS0,GE'.PTB) GO TO 568 

VmBSO a C2CPTT»(1,-{PSB/PTB)*»CFGT) 

Go TO 53j^a 

5316 VMBSO a PSB«RS8 
5318 1F( IRET’.NE’.O J GO TO 5414 
VMLBSQe VMBSQ 
PlB a psB 
Go TO 540 

c free or riEi*D lower boundary 

532 IF(TYPELB(L)';nE;FREE .and. TYPEL’8<L>,NE. FIELD) GO TO 534 

M s mA 

Call getix 

IF(MU.EQ.O) gall ERRORl 
VMLBSQa VM(MU)»VM(MU) 

533 PlB a l'.E-6 

IF(TYPELB(L)';nE. field .or. PASSl) GO TO 540 
vmubsq= o’. 

IF(TYPEUB{L)'.’eQ'.FIELD) go to 570 
c STREaMWISE interpolation of velocity At ISTAGr3 POINT BY 

IRET a 1 

5331 Ma a h 

CALL GETRlX 

II a 0 

Nil = 3 

IF(M2.EQ.M4) go to 5333 

II = 1 

Nil *4 
Sl8( 1 I >*S1(M2) 

V18( I I )8VM(M2) 

5333 SiB( 1 UDsSlf'IS) 

V18M I*l)aVMrM3) 

Sl8( I I*2)sSlfM5) 

V1B{ I I*2)aVM(M5) 

Sl8( I I*3)sSlfM6) 

Vl8( I I*3)aVMlM6) 

IF(m6.EQ.m4) NII*NI1-1 

call LSPfIT(S 1B,V13,N1 I , Sl(M),vHM,i, Oj 
IFIIRET) 5333.5435,5335 


LSPFIT 


173 



53,Ji> VMLBSQa 

RO TO 540 

FAR-FIELn LOWER rOuNDARV 
^ SO TO 540 

call errori 

2 (Ma),VMLBSQ, 1 , 

VMLBSQb VMLBSQ»VMl3S0 
GO TO 533 

UPPgR bOUNoaRV 
540 VmuBSQ* o'. 

PRESSURe'uPPER BnUNDARV 
|F(PUB,Gt'. 0; ) Go TO 541 
jF(TYPEUBa)7.ME;pRES) GO TO 542 


0 ) 


541 


i«et 

PS8 

PTB 

bdynm 

zbpt 

cfgt 


1 
PUB 

PT(fJK) 

NAMEU8<L) 

Z(M3J . 

1./{1**FGR(NK) ) 
C2CP^NK)»TT(NK) 


5414 


542 


543 


5435 


544 


568 


C2CPTT* 

SO TO 5306 
VMUBSQsVmbSQ 
Pu6 s PSB 
So TO 570 

free or field upper boundary 

^F(T PEUB(U:nE.FREE ,AND. TYPeUB( L ) , NE ; F IELD) go TO 544 
SAll GEtIx 

IF(MU,EQ,0) call errori 

vMUBSQs Vl:((MU)<‘VM(MU) 

PUB s i.E -6 

!^J'''“fBa)TNE;r,ELD .or. passu bo to 570 

GO TO 5331 
vmubsqs vmm«vmm 
So TO 57o 

FARrtFIEld upper boundary 
IF(TYPEUB(LJ';nE.FaRFlO) go to 570 

vnueSorvil^lS.^liSssf ' 0. 

Go TC 543 

Z<M),R(M),PSB»PTB 

call errori 


S7o"^^(t2uRso^'5ML^sSfe^^‘’‘-- "EOUESTED 


WoTTt- / A - 7n-*nT'''r * • SP • tNOTpCHOKS> go To 580 

><Ml),L,TYPElB(L).TYPEUB(l) 

errori 


call 


iteration 
’ VRSa(NK)»VHU8S0 

VMSQSVs VMSQ^NK) 

^NE^T^rr^ salvaging NEGATIVE TEMPERATURE SITUATIONS 

VVSAFEs o'. 

So TC 600 

590 NgQTS s NegT9*1 

if(negts.ge.8o ;or, (plb*pub);ne.o, » call errori 
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VmSQ(NK) = ;5»<VMSQ('JK)*VVSAFE) 

C»*»*STeP by step I'^TeGRATJON of normal momentum equation 

«*0n VRATlns VmSQ{.NK)/VMSQSV 
K S NK 

c predict velocity at k 

610 K S k;i 

1F(K) 615.‘650,6l5 

C COEFFICIENT VALUES AT K*1 

61^3 TS(K*1)»TT( <H)«VMSQ(K*i)/C2CR(K*l) 

CDPTl = RQ(Kn)»TS(K*l>/P7(K*l) 

C COEFFICIENT VALUES AT K 

vmsq^kJsvmsq^kUvratio 
6B0 VMSQK s VMSQCK) 

TS(K) = T7(Ki-VHSQ{K)/C2CP<K) 

COPT r COPTl ♦ RQ(K)«TS(K)/PT(K) 

c Integrate 

IFID1SPIK)'.NE,0.) GO TO 625 , , . 

622 VMSO(K)sVMSQfK*l)«»VVKQKP(K) ♦ SQRTVV ( K ) * ( COPT * ( PT ( K > -PT t K*1 H ) 
GO TC 630 

C (WAKE OISCOMTINUITY) 

625 lF(PT(K*l);Ee;PTlK>> GO TO 622 

PSLIP * PT(K+1)«<TS(K+1)/TT(K*1))«(TS{K*1)/T7(k»1>)»»FGRIK^1) 

lF(PSLlP.Lt;PT(Kn GO TO 628 
M « MA*K«.1 

WRITE (6. 1628) PT(K>,PSL1P*Z(8);R(M) lOVtl) 

628 TS(K) a TT ( K J •< PSL I P/PT ( K ))/( PSl IP/PT ( K ))**( FGR I K )/ (1 . ♦FQR ( K )> > 
VMSQ(K)«C2CPi’K)«(TT(K)-TS(Kj ) 

630 VMSQ(K)«AMAX1(VMS0(K> » ,0001) 

IF{ ABS(VMSO(»0/VMSOK=1 , > ,GE;2,‘Ee5> GO TO 620 
GO TO 610 

C,.,,,EN0 iNTEGRATtON OF MOMENTUM EQUATION 

c** integration of flOw area 

650 AREA(1 )»AREAQ(1 » 

M s MA 

Do 660 KaliNK 

VM(M) e SQRT(VMSQ(K) ) 

IF<MCmEQ'.NE'.0> QO To 654 
TS(K> s TT(K|'*VMSQ(K)/C2CP<K> 

IF(T5(Kj .LT; 8; ) CALL ERRORl 

654 continue 

IF(TS(K) .lT’, 0'. ,AND; FGR(K)’,Ne.o;» GO To 590 
RH01K>= PT(KJ/(RG(K)«TT(K) ) • (tS(K)/TT(K) )««FGR(K) 

WQA(K)s RHO(K)«vM(M> 

IF(M,EQJMA) fio to 660 

C NOTE - average FLOW/aREA IS APPROX IMATELY S(JRT ( WQA( K-1 ) *WQA( K M 
WQAVG s W0A(K)*WQA(K-1) n 

X s (mQA<K)-WQA(K-1M«(wQA(K)-HQAIK-1> )/(W0AVG«WQAVQ» 

AReA(K)=AREAfK*^lJ ♦ 2 , • ( WST A( K ) ;WSTA ( K»1 ) ) / 

^ (WQAVG*a‘.sX*< , 5 *x*{ ; 1254 X«, 0625 )) ) ) 

iF(DIspjk,i)';le;o, > 20 to 66 O 

PERIM 8 ;5*(LaMBDa{K-1)*LAMBD«(K) ) 

655 AREA(KlaAREA(K-t)*DlSP(K-l)*PgR!M 

660 M 8 N*l 

c,,, end flow area integration 
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reciprocal or calculated flow area, etc, 
IF(MOmEQ.eQ'.O) go to 740 
oarea s i;/areaink) 

VM8C = VM(M0; 

IF(PLB»LT’.o'. .or* !>UB*NE*0 0 dO TO 740 
VMSQSVs VMSQfMK) 

VVSAFE= VMSQSV 
IF(VMlBSq;nE70; ) go to 710 


c 


call 'qirem' for next quess of VM(NK>*VMBC 
IF(QV(1) ',nE'.9'. ) go to 68 0 
TO s i'./TArEA 
TTOL s i;e-9»YQ 
IF(WF ,NE. o', ) Y05YO»WF/WSTAtNKl 
DYDX 8 DwpVfL) 

IFiDYDX'.EQ.o'.’ loR. OYDX.EQ'.XCHOKE) DYDXbYO/VMBC 
IF( ;N 0 T;cH 0 KE) go to 675 


YO 8 
675- QarEAIs 


YO*YO 

qarea 


VUBl s vmBC 
680 XJP a L'.75 *vMbC 

IF( ,NOT;suBS0N) XJ!> = ,25»VMBC 
call OiRfMf VMBC^OAREA, XJP^OVJ 
IF.(QV( 1 ) .EQ'.o'. ) Go TO 6®2 
IF(QV(5 ).eQ;b 1 ) GO TO 604 
VMSQ(NK»avM8C*VMBC 
Go TO 6 qo 


evaluate d(w}/D(Vl9), save velocities 

682 BOT s VMBC-VUBl 

iF( abs(bot) ;gt; 1, ) dhuv(l)»<QaRba-oarea1)/'bot 
GQ to 740 


c the flow is choked 

684 IF(CHOKE) go to 740 
Ratio a qareaoTarea 
Dq 686 Ksi*NK 
686 ARea(K)sRaTi8«AREA(K) 

Call adjwf2 

Go TO 740 

c CALL »OiReMi for LOWER BOUNDARY PRESSURE ITeRaTjON 

710 YD = VMLBSg 
YTOL = i;e-5«yo 
DYDX s 1. 

Call oIREMI VMSQ(NK) , VHSQCD .V.SttVMSOlNK) ,QV) 

if(qv(i)'.ne;0; > go to 60o 
c calculate boundary pressure 

740 PlBC * RH0(1)*RG<1MTS<1J 

PuBC s RH0(NK)»RG<NK)*TS(NK) 

WRQST s WStAtNKj 

WCALC s WRQST»QAREA»TAREA 

IF(TYPELB(L)'.'nE; TE) go to 745 

FGRTE(L)sFGR{1) 

RGTE(L)«RG(1} 

PTTE(L)=PT(1} 

PSTE (L )sPL8C 

745 IF(TYPEUB(L);nE;TE) go to 780 
FGRTE(L)=FGR^NK) 

RGTE(L)=RG(NM) 
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PTTE(U*PT(N«) 

PSTE(L)i»PuBC 

780 lriPDUM{9> ’.LE.O; » GO TO 900 

IF(XKL) .GE’.PDUH(fl) |AND, XI < L ) LE , PDUM ( 9 ) ) GO TO 800 
GO TO 900 

800 Call tabprtOhsta.xkl) iLNExT{l^ .5> 
call EDUMPl 

c HESET PL8 and PU3 HDICATORS 

9U0 PlB =0'. 
pua = o'. 

c compute Shock loss 

IF(PDUM(10) ‘.EQ'.O; ) RETURN 
K = 1 

M s Ma 

910 SQM s VMSQ<KJ/<1.4»RG<K>»TStK) ) 

IF(S0m.LE’.1. J go TO 920 
call GETIx 

IF(MD.EO.O) so' to 920 

VVMXSQs vM(HD)*VM(MD)/<C2CP(K»*TT(K) > 

SQMd s 5'.«VVMXSQ/{1,.VVMXS0) 

IF (SQmD.GE'.I'.’) go to 920 

OPTR = 1’. • ( (6.»SQH)/(SQM*5;))»*3,5 * ( 6 , / ( 7 . »SOM«»l , > ) *«2 1 5 
PTR(J)s PTR<J> • (l*'PDUH(18)*DpTR) 

920 M s M*1 

K 5 K*1 

IF(M,lE'.MB> ®0 to 910 
return 

1568 FORMAT! 58H »t» ERROR IN FLOBALV REQUESTED BOUNDARY PRESSURE EXCEE 
«DS/6X3 ThT 0TAL PRESSURE AT TRAILING EDGE PO I NTFll . 5 , IH i FU • 5 » IH . / 
!!6X3 HPSsF8'.3i8X3hPTsF8,3i ) 

1570 FORMAT!" IN EVALUATING MAX FLOW AT STA = "F6’.3»" !L*'^M, 

<s”) Routine flqbal finds type •*a6,ih,a6i'» boundaries. »?/ 6xi 

<S"VARYrF MUST BE INPUT FOR CHANNELS ADJACENT TO FARFLD, FREE; OR P 

«REs Boundaries’, 

1628 FORMAT!” WaRNING-JUST BEL'OW SLIP LINE, PT IS LESS THAN PS. S 

getting Vs'.017”/6X,3HPT = F8.3.'6H PS*F8,3.6H Z = F8,3,5H R*F8,3, 

&6H qVsFs'.O} 

End 
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•DECK LFIT 2 D 

Subroutine Lfit2D(x, y.to.nxy) 

LIMEaR surface interpolation »LFIT2D* 

c IN A Rectangular grIo 

dimension X(2> ,Y(2),T0<2> 


c 

c 

c 


input- 

5 list of coordinates at which interpolated values are to be 

NXY a NO OF CqOROIvjATE POINTS 

NXT = number of XT 

NVT a number OF YT 

^T 8 x-GRID OF T'TABLE 

YT a y-GRID qF T’-TABlE 

Y a table of values 

note number of t-values is nxt«nyt» order is illustrated below 

YT(NYT)A T(3) T(6) T(NXT*nYTJ 

YT(2) • T(2) T(5) T(8) 

YT(1J 0 T(l) T(4) T(7) 

XT(1) XT<2) XT(NXT) 


c output. 

C TO a interpolated VALUES AT X.Y 


COMMON /CTHICK/ NX T , N YT , XT ( 20 ) . YT ( 20 ) . T { 78 > 

FqmmOn /erase / DuM( A 00 >) ,T1(200I *T2(200) 


C 


100 

10b 

111 ) 

120 

125 

140 

145 


Find correct x«interval 

1 a 1 

M a J_ 

Isv « 0 

NCOUNTa 0 

lF(X(M>iLT'.XT(I)) GO TO 110 

if(x(M);gt;xT(i*i)) go to 120 

F = (X(M>-XT(I J>/(XT(I*l)-Xtn>) 
Go TO 15 q 

IF( I .EQ'.I) go to 140 

J * 1-1 
Go to 125 

IF( ( !♦!) .gE'.NXT) go to 145 
I a 1*1 

NcOUNTs NcOUNT*! 

IF (NCOUNt'.GT?NXT) call ERRORl 
Go TO IO5 
F = 0: 

Go TO 150 
F SI’ 


Interpolate mrt y 
IF(i,EQ;isVJ go To 160 
Ij2 a I*NYT*1 

lui 5 IJ2-NYT 

Call lfItiiyt.ti iuii.nyt, y.'ti.nxy) 
Call lfiti<yT,tm j2 J ,nyt, y;t2,nxyi 
I sv a I 


c Interpolate wrt x 

160 Tq(M) a F«T2 {m)*U|-F)»T1IM> 


M a, M*1 
IF(M.lE.NXY) go to 100 


178 



f • • 


NTERPOLAT I ONG TO(M) 


AT X(H) lYtH) ,M»1«NXY 


C 


END UOQP FOR 1 


return 

END 


179 



nnn nn no* ono onononoorjoonno noo 


•DECK TTPT 

SUBROUTINE TTPT (MA. MB. WSTA, OISP. WAKE iTT.PT. LAM. RQXi C2CPX . FGRX ) 
•TTPT-- TT. PT. and RCU FOR STREAMLINES PTTPTP 

logical wake 

REAL LAM(25) 

DIMENSION W9TA(25) .DISP(25) .YT<25) ,PT(25) , 

1 R®X(25) |C2CPX(25) .FGrX<25) 


INPUT- 

MA s first field POINT 

MB s Last field point 

OUTPUT- 

WSTA s list of stream FUNCTION VALUES 

DISP(K)=N0N-2ER0 for possible slip condition BETWEEN STREAMLINE 
K AND K*l. OTHERWISE DiSP(K)*0i 
= displacement thickness of WaKE if POSITIVE 
WAKE = .true; if there EXISTS ANY WAKE DISPLACEMENTS’. 

TT a lNtE*POLATED TOTAL TEMPERATURE 

PT a InTE«POlATED TOTAL PRESSURE 

LAMBDAa LAMINA THICKNESS IN THIRD DIMENSION. BLOCKAGE EFFECT 
RCU s interpolated angular aOMENTUM ***N0T NOW IN USE 

RGx a GAS Constant 

C2CPX a SPECIFIC HEAT 

FgRx X i; /( ®aM,1 . ) a FUNCTION Op GAMMa for calculating density 
note - LENGTH OF WSTA. TT.PT.'RCUsLiSTS IS MB-MA»1 

WAKETB, CONVTBk CADJWF 

Table of convected properties 

INDEX, LTaLTO.LTE 

Common /ChDATA/ CH(l)»LTNEXT(l).’NPTll>iLPSm).LTT(l).LPT{lJ* 

1 LRCU(I). 

CRG( 1) .CPGJdJ .C2CPI1) |0GAM<1) .FGTU) ,FGP(li; 

^ FGR(l) .AREATB(4B5) 

integer CH 

dimension XCH(1) 

Equivalence (ch.xch) 

SEE OTHER LISTING OF TTPT FOR EXPLANATION OF VARIABLES 
FLOW adjustment TABLE 

Index- LFaLFo.LFE 

dimension XlFa),x2F(l).xiBF(l) iXiAF(l). 

I SlFU) .NcMBdliNCHAll) iJORDER(l) ,VNR(12I 

equivalence <LFB,XIBF>, (LFA'.'XIAF). (LRF.NCHB) . (LRXF.NCHa? 

DIMENSION LFB( 1) ,LFA{1),LRF(1) .LRXF(l) 

table of wake displacement thickness 

INDEX, LWaLWO.LWE 

dimension X2»(l)iLWNEXTa) .S1W(47) 

dimension DST(i) 

EQUIVALENCE (DST.SLW) 

SU8TABLE ARRANGEMENT IS" 

x2w,lWNExT(>2*2N). S^W < 1 ) . s1W( 2) . , ,s 1W I N> » DST ( 1 ) . DST ( 2 ) , ; , DST tN ) 
X2W a streamline COORDInAtE 
C Siw a distance ALONG STREAMLINE FROM TiE, 

C DST s wake DISPLACEMENT THICKNESS AS A FUNCTION OF SlW 

equivalence (CH,X1f.X2W), (LTNEXT,X2F,LWNEXT) , <NPT,X1bF;S1W) 

equivalence (LPSI »XiAF).' (LtTiSlF)i (LPT^NCHB)* (LRCUiNCHA) 

equivalence (CRG.JORDERi. (CPGJ.VNR) 


COMMON /SLTA8 / W ( 123 ) . X2 ( 120 J . SLCHN ( 128 ) 
integer SLCHN 

Common /ixorIg/ lho.lhe, lbdo.’lbde, lto.lte. lwo.lwe, lfo.lfe. 
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DIMENSION 

equivalence 


LO,LESTA, LDUM<a>, 

NJ.NrCOLS* HAXNJ,MAXOHMAXNMiMAXLE» 
leo#leei lro»lre»lrd 

LIM1TS(24) 

(LlMlTSiLHO) 


COMMON /CIDEX / 
COMMON ''CMAXIT/ 

Common /cptmov/ 

COMMON /CR / 

Common /csi / 

Common ^cthi6k/ 
Common /cz / 

common /erase / 


M, J.MJiMD. ISTSG 
MAXlT#MAjCTR#eREriN,EDUM 
VELPOT, ICOa.NODENSiCPTDUM 
RC300) 

Sl<300) 

NTHKX,N.THKY;7HKX(20)»THKY(2D) ,TH1K2D(78) 
Z(300) 

psnsoo) 


integer chx 


c interpolate FdR lamina thickness 

NK = MB-MA+1 
Call setm(1,i;, lam.nk) 
iF(NTHKX.LEil) GO TO 100 
Call lfIt 2 D( 2 (Maj , R( ma) ,LaM;nk) 

c initialize 

luo wake s .false; 

c define NIJmbER of streamlines, NK# associated with each channel 

K r 1 

M a mA 
WADO a o'. 

10& NK so 

Kl a K 

Ml a 

110 Call getix 

if(m,ne;m1) So to 114 

Chx a SLCHNUI 
PSll a X2( J) 

114 If (sLchN( j) ; ne'.chx) go to 120 

NK * NK+l 

nisp<K)*o'. 

WSTA{K>swiJ)tWADD 

Psi (NK)sx 3( jj 
K - K*1 

H a M*1 

IF(M,LE;MB) fiO TO 110 

c find Index in convtb 

120 LT a lTO 

i2?> ifilt.gt.^teJ Call errori 

IFICH(LT) .EQiCHX) GO TO 130 
Lt s LT*LTNEXT(LT) 

GO TO 125 

C interpolate for cONVECTED properties 

c SCALE the psi Table to conforb to the lrsutable in /convtb/ 

130 NI S NPT(LT) 

I s LT*LiSlILT) 

12 a UNl 

Jfiki,eq;i ;and. nk.eo.d psIispsii*8, 

PSIl S 8'.«AlNT{PSIl/3,y 

F 3 XCH( 12 - 1 )/ 3 . 
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UU X**U 

140 PSI (KN)a(PSl fKN),PSll)»F 
IT 5 LT*LTT(LT) 

IP s LT*LPT<LT) 

Is s LT*LRCU(I.T) 

CALL LSPntteHlI ),CH(IT),NI, PS f , TT (Kl ) , NK , 0) 

CALL LSPF1T(CH( 1 > ,CH(IP) ,Ni; PS ! . PT ( Kl ) ,NK , 0) 

C call LSPFlT{CHn)iCH(IS)#NI* PSf »RC|J< Kl ) . NK * 0) 

CALL SETM(1,CPG(LT) ,RGX(K1),NK> 
call SETMtl,C2CP<LT>,C2CPX<Kl),NK» 

Call SETMd.FGRiLn .FGRXCKD ,MKi 

C wake displacement thickness 
c Search for x2-subtable 
if(m,gt;mb) So to 200 

X2J s X2(jJ 

DISP<Kil) 3 -l'; 

LW s LWO 

if(lw,ge.lwe) go to 190 

IF(X2W(LW) *.EQ.X2J) GO TO l7o 
Lw s Lw*LMNEXT(LW) 

GO TO 155 

G find TRaIlINS edge si in the flow adjustment TaBLEi SIF 

170 lF s LFp 

175 IF(X2F(LF) .EQ.X2J) GO TO 180 
LF s lF*NFcOlS 

IFILF.LT.lFEJ go to 175 
call ERRORI 

c Interpolate for WA*<e displacement thickness, dstaR 
lao sifte=si<m)«.sif(lf> 

C SUFROMiT'.E'; 

IFISIfTE.lE'.O; ) GO TO 190 
N s (LWNEXT(LW)-2>/2 

LSTaR s Lw+N 

Call lspfit(Siw(lw),dst(lstar),n, Siftb,disp(k.i> ,i, o> 

lF(DIsP<Kil) jl 184,184,186 
184 DlSP(K-l)a*l. 

GO TO 190 

186 wake » .true'. 
c LOOP fqR next channel 

190 WaDD s WSTAfK-1) 

Go TO 105 

* 

c USE constant density approximation for MAJCTR.LE.NODENS 
200 ifImajctr;le7nodens> caul SETMIi,0,,FGRX,K-1> 

RETURN 

End 
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OvERLAY(STC,a.l) 

PROGRAM STCX 

Common /Aojwri/ MODEiiPr,MoDS0;i.r0 
COMMON ^select/ LENTRY 
Go TO <10;20^30, 20 ) .gentry 
lU call ADJWFtMOOEO'LfO) 
i!o Call staloo 
Go TO 40 

Call ADJwr(MOoE,LFn 
40 return 
end 
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ciooocj ooooooonno ooorsono on oooooncjo oonoonrj 


•DECK ADJNF 

SUBROUTINE AQ JWP ( MODE »UPF ) 

•ADJWf- adjust weight FUOW »ADJmF# 

INPUT* 

mode ■ operation mode 

» -1 eqr Evaluation of tErwf Ay uPf 
« 0 POR adjus.tment op Flow rates at choked stations 

s 1 FOR ADJUSTMENT OF FlOWS FOR KUTTA CONDITION AT T,B. IFF 

lff s Flow adjustment table <t,e.> indEx 
TOLWFU a tolerance ON TfeRWF 


OUTPUT- 
MODE = 1 IF FLOW rate Has been CHANGED FOR TE^LFF 
MODE = 2 IF TErLFF HA§ CONVERGED AnD LFF HAS BEEN INDEXED 
MODE = 3 IF ALL T£ S MAVE CONVERGED 
note-above output OCCURS FOR MODE^I INPUT 
TEX12 * T.B, X12-C0QRDINATE 
TWF a FLOW RATE OF VARIABLE CHANNEL 

TERWF « KUTTA CONDITION INDICATED FRACTIONAL FLOW ERROR 


C 0 MB 3 

cadjwf, chdata, STATAB 

COMMON /CHOATA/ CHN AM U ) i LR nExT { 1 ) , WTFLOW I • TTO < 1 > » PTO ( 1 ) # 
• TS 0 (l)|PS 0 (t),MACHO(l);AOflT»VARY« 5 )|TA 8 U) 


integer CHNAM 

logical vary 

FLOW ADJUSTMENT TABLE 
index- LFpIFOiLFE 
NFCOLS* 8 

XlF * ORTHOGONAL COORDINATE 

X2F a streamline COORDINATE OF SL EMINATIHG FROM T,E, 
XIBF a X1«C00RDINATB OF CHQKE STATION OF FLOW BELOW T,E, 
XlAF a Xi,C00RDINaT 6 Of CHOKE STaTION OF FLOW ABOVE T,E, 
SIF a SIbCOORDINATE UF T,E, (UPPER SURFACE), THIS ITEM 
IS USED WHEN INTERPOLATING FOR WAKE DELTA-STAR| 


1 


UFBiLFAsTNDICES of stations BELOW AND ABOVE T,E, 
NCHB.NCHAaNUMBER OF CHANNELS bELOW AND ABOVE T,E, 

LRF a INDEX OF DUMMY QRTCHN LIST FOR THE T'.E, 

LRXF B INDEX OF LAST CHANNEL BELOW THE T 7 E^ 

JORDERa 0 |F TOTaL FLOW AT XlF IS OIVBN 
■ 2 IF FLOW ABOVE T,b, iS GIVEN 
a 1 IF FLOW BELOW T.E. IS GIVEN 
JORDERa -1 IF FLO^ AT X^F IS CHOKSD AND StNQLE CHANNEL 
dimension XlF<l)iX2Fa).XlBP(l)»xlA(?(t) . 

SiF<i)^NCh8<1,,NCHa(1J ,J0RQBR(1),VNR(12) 
equivalence tLFB,Xl8 F), {LFA,XiaF),<LRK ,NCHB)i aRXF.NCHA) 
DIMENSION LFBaljLFAlD.LRFdl.LRXFfl? 


station Table 

INDEX- LaLOlLESTA 

SCHOKEa STATION CHOKE INDICATOR ( ADJWF,BRWS,’WRI0UT> 


1 

1 

& 

& 

& 


MCL a SHARP CORNER INDICATOR (BLDTBS) 

MCL a FieUD INDEX OF CONTROL STREAMLINE (PTM0VE|FL0BAL) 

DIMENSION Xl(i)»LNExt(l),MLB(l);MUBeiTiPRlMUI » 

TYPElBUJ.NaMELBU), ILB<ll,fUB(l),SlLBU» 
TYPEUB(U,NAMEUBa>i IUB<li irUBa)|SlUBU» 
VM8<i)|0WOV(l),x2CL<l)V8LSW|(A)|H0La)< 
angte<i)iptte(i),pste<i»;fgrte<i)»rgte<i) 

ANGEXPUIiBsOEXPIAT?) 




DIMENSION CRVLE(1>iANQLE(1) 

EQUIVALENCE tSCHOKif DwDv ) , I CR VLB i AN«T6 ) J ( ANGLE i PTTfc ) 

integer prim,typelb,typeub,schokecit 
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EUlJlVALbNCg (CHNAM.XXF.XI) , ( UHMEXT i XIF »LNEXT ) 

EUUlVALkNCB ( WTF LOW* XidF » MI.B ) i ( TTO*XlA(? , HUB) i iPTO#SlF , PR I M ) 
EOUlVAUtNCe (TSO,NCHy,TYPEl.B), (PSOiNCHAiNAMELB J 
EUUIVALENCE (MAUHO.JORUEH, Il8)i ( AOj'VNRkFLB), ( VARY ( l| * SIlB ) 
EQUlVALbNCB < V aWY ( 2 > * T YPbuB ) , ( V A« Y ( 3 > V NAMEuB ) , ( VA«Y< ^ , I U8 ) 

EQUlVALtNce (VAWY(5 )|PUb) 

EQUIVAUENCE (Ta8(i) , A«EATB,SiU9)i (TABf27i VMB), ( TAB ( 3 ) , DWD V) 
EQUIVaUENCE (TaB< 4) ,X2CU) , (TAB(5),SL9Wt)i'(TAB(^) iMCW) 

c 

COMMON /ALLCOM/ MACHA#P§A, TsA,PTA,TTAi AXtAi’RGAi GAMA* 

1 MACHC*PSC,Tsa,PTC,TYC» AxTC * RGC , GAMC i 

2 DAXI7,ScAlEA,TTe,CHOTST 

real MACHA(l) iMACWC 

logical axIa.axic.chotst 

common /CF8 / L|MA,Mb,PLB,PU 8 ,WF,CHOKB;sU 0 SON, NK, PLBC, PUbC, 

1 XCHOKhi TaR£A,VmBC, WR09T,WCALC, OV ( 8 ) * QVP ( 8 ) » 

* jgum.vmlbsq 

logical ChOKSiSUBSON 

integer XCHOKE 

COMMON /css / SSFMLiSSEFiSSEANG.SSor.SSFEND.SSFNOX 
1 ,SSDLE*A4FACT,8RLX,CURRLX.TSrC 

integer ssfml 

LOGICAL SSEFi SSDF, SSDlE 

COMMON /ERASE2/ AREA ( 96 ) * A^E AO ( 96 ) , D 1 SP (9i ) ,“PT ( 96 ) * L AMBDA ( 96 ) i 

1 RHO(96)#SqHTVV<96) ,TS(96UTT(96) iVMSQ(96) , 

2 VVKQKP<?6), 

2 WOA(96IrWSTA(96>, RG ( 96 » .'C2CP ( 96 ) * FGR ( 96 ) 

heal lambda 

dimension gS2(96) »SDMQRM(96) 

equivalence tbSa.VVKQKP) ,{S dNORM,RhO) 

dimension RCU(96) 

equivalence <KCU, LAMBDA) 

C INPEXf* M«MO»NM 

COMMON /CZ / 21300) 

COMMON /CR / HI300) 

COMMON /CSg / S2(300l 
COMMON /CSl / SK300) 

COMMON /CPWll / PHU(300) 

COMMON /CM / JMS<300j 
COMMON /CCURV / CURV(300) 

common /CR / B(300) 

COMMON /CIDEX / M, J»-MU,MD, ISTaQ 

COMMON /IXgRiG/ LHO;lHE, LBDO.LBDE, L^O;lTEi‘ lWO.LWE, LFO.LFE, 

• LO.LESTAi LDUM(8), 

» MO.NM, NJ.NFCOLS. MAXNJ,MAX0L.MAXNM,MAXLE, 

O LEOiLEE# LRO*lBE*LRD 

dimension LIMITS(24, 

equivalence lUIMITSrLHO) 

COMMON /SLTAB / W(123)*X2(l28)iSLCHNa28> 
integer SLGHN 

COMMON / CTE / TOLWF,TOUWFUiTEXl 2 ,TwF,TEBWF, JRET 
COMMON /CINNER/ INRCTH , ROUM , N I NNER { 16 ) . CN VFU6 ) 

COMMON /CPRlNT/ CDUMI 6) fPDUM(20) 

COMMON /cqirem/ ytol» yo*dyox,ctrmax 

COMMON /CTABRR/ IlTAB 
common / CGRAV / CG 

namelist /ADJI/ PSTEiW8fWCAl,C,MA8,Y0 

c begin loop througw flow adjustment table 
IF (lfFjEq; 0) lff»lfo 
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IF • 

I»^(l,r,Qfc.'LFe) GO TO 390 
aoo IF( JOHDERU-F ) ,EQ,‘3> GO TO 3i0 

r. HOOEaii This entry foluors a hode*-ii continue the caucuuation 3y 

c JUMPING TO the PKEVIOUS E*IT POINT, 

IF (MODt.EO.l ,AND, LF.EQ.UfF) QO TO ( l58-, 231 ) , JRET 
PtB * 0, 

PUR = » 0. 

WF s 0, 

CHOKE a ;false, 

SUbSON* ,TRUE, 

X1T6 ■ XIFIUF) 

X2TE a X2FILF1 
I.XA * 1 
UKB a 0 

IF( JOHDfeRlUF) ,LT/0) GO TO ll8 

C search for the two stations at XlFeuF) 

CALU STAXl(Xj,TE,X2TE,X2Tfc,Lx9.UXA> 

C SEARCH FOR CHOKE STATION IF THE FLOW IS OHOK0O UPSTREAM 
UKB a UYB 
LKA * LXA 

1F(X1BF(UF) .NE.XITE) CAUL ST AXl ( XIBF ( UF) , X2TE , -1 , i UKB »l)UM) 
IF(X1 aF(UF) -.EQ.XITE) GQ TO 120 

Ua CAUU STAXl(XlAF(Un,,.l^,X2TE,0UM»UKA) 

120 IF(MODE) 122,130»122 
1.22 IF( JORDERIUFP 300,140,200 

C SINGLE CHANNfcU CHOKE 

130 IF(J0RD6R(LF),EQ, ’(-!)) GO Tq 133 
IF (UKB,NE;LXB) go to 132 

131 IF(LKA,NB.LXA) go to 133 
GO To I3fl 

132 L ■ LK8 

GO TO 134 

133 U * LKA 

134 CHOKE a .TRUE, , 

CALL floral 

schoke<u *xchoke 
LK 2 a L 
VMB(U)* vmbc 

ratio a WCALC/WRQST 
assign 135 TO iRgT 
TEXJ2 * X2T6 

IF (UKBiBOiO .OR,’ L.EU.LKB) TwF a wOALC-CG 
GO To 255 

135 1F(L,EQ,LKB> GO TO 131 

136 Lf" a LF*NFC0LS 

if(lf,lt;'ufei go to lOo 
GO to 900 

C»« iterate for T;‘e, PHESSURp, JORoERlUDaO 
140 PTEHIN a •1,B6 
PStE a PTEMIN 
IF< ,N0T,CH0TST) QO TO 150 
L » LKB 
choke a ,'TRUE, 

CALL FUOraL 
PUBX • RUBC 
WBCHOKa WCALC 
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WBO « WROST 
L * LKA 
call riOBAL 

PLBX » PU8C 
wacwok* WcaUc 
CHOKE ^ , FALSE, 

C T,fc, STATJOr^ PRBSSURt 

IF(LKB,hQ;uXB) (50 TQ 142 
L * UXB 

WF « WBCHOK 
CALL FLOBaL 
PUBX 9 PUBC 

142 lF(LKA,fcQ,LXA) GO TO 144 
L * L^A 

UF 9 WACHOK 

call flobal 

PLBX * PLBC 
144 WF 9 0. 

SUBSON » , TRUE, 

PTEMIN * AMINKPUBXI’PLBX) 

PSTE • PTgMlN 

IF (SSDF .and. LKB ,Nb, LXB ,aNd, LKA ’.NE7 LXa ) QO TO 1576 


150 QVP(l>* 0. 

155 L » LXB 

PLB • O'. 

PUB • PSTfc 

call flobal 

VMBSAVs vmbc 
PTB * PT(NK) 

WBO 9 WROST 

WB « WCALC 

L « LXA 

ir{QVP<lJ ,BU;0, ) PSTE=PUBC 
PLB ■ PSTt 

PUB » 0. 

call flobal 

yo 9 WBO*WR(3ST 
IF{ ,N0T,CH0TST) go to 157 
TF(PSTE,LT',PU0X) Wb^wBCHOK 
1F(PS7E,LT;PLBX) wcaLC^WACHQK 
157 WAB « WB*WCALC 
VTOL * 1,B^3»Y0 
DYDX 9 -l',E«5 

1F(PDUM(6J ;EQ,2, )WRITt(6,A0Jl) 

CALL QI«EM (PSTE, WAB, ,5»(AMINi(PT(i>,PTBUPBTE),QVP} 

IF (PS7E ,GE, PTSMIN) GO TO 1574 

WBP = CG«WBCH0K 

WAP s CG«WACHQK 

LFPR s LF * 3 

WRITE <6,1157) (XlFd )| 13 L^.LFPR),PTEMIN;hBP,WAP 
GO TO i576 

1574 IF(QVP(1) .NE.O, ) GO TO 155 
VMB(LXB)*VM8SAV 

vnb(lxa)*vhbc 

C indicated FLOW ADJUSTMENT E«R0R 
YY 9 (WB-WBO)/YO 
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XX « WBO/YO 

GO TO 1^70 

C T.E, of 2 CD-NO^^LES 0« BOTH CHNS CHOKBD 

1976 YY « 0iTi> 

XX X I, 

1978 ?Exl2 s X2F(LF> 

TWF X WBO“CG 
TERWF * YY 
JHET s 1 

IF(MODE,eOiUl> ) HETUBN 

158 1F(XX ,EQ, 1.) GO TO 1585 

IF< ABS<YY) ;UT,T01.'^FU) GO TO 3Q0 

• mark station table choke indicator 

1^85 IF{ iNOTeCHOTST) GO TO l59 

IMPSTE,LE;PUBX) SCHOKE(UKB>aXCHOKE 
1F(PSTE,LE-,PLBX) SCHOKEaKA)sxCHOKE 

c obtain next flow iterate 

159 IF (XX ,EQ; 1, ) GO TO 165 
1F(VNR(LF);nE,0.) go TQ 160 
VNR(LF*lJ*ii2, 

VNR(LF*2)»,1 

160 XXMEW X XX 
VNR(LF*6J*0| 

call NEWRaP(XXNEW, YY, VNR(lF ) ) 

IF( VNR(LF*6) ,EQ, (-1. ) ) XXNEwsxX 
RATIO « XXNEw/XX 
GO TO 166 

165 RATIO a WBCHQK/Wao 

166 ASSIGN 170 Tq IRgT 

L a LXB 

GO TO 255 

170 RATIO • Ui-XXNEW)*Y0/WRQST 
ASSIGN 900 To IRgT 
L « LXA 

IF (XX ,NE, I,) GO TO 255 
RATIO * WaCHOK/HROST 
ASSIGN «500 To IRgT 
GO To 255 

Caa calculation OF Te PRESSURE <GIVEN FLOW) aT STATION UJ<1. 
Caa U0HDER(LF)?1,Z 

200 IF( JORdER(LF ) ,EU;2) GO TO 2q 5 
C JORDER’l 

LXl a LXB 

LX2 a LXA 

LKl a LKB 

UK? a UKA 

60 TO 210 
C UORDERS2 

205 UXl s L><A 

UX2 a LXB 

LKj. , LKa 

LK2 * LKB 

210 L ■ LXl 

CALL flobal 

yMB(L)« VMBC 

IF( J0Rd^:R (I.F) ,Eq,=2) SO TO 220 
PLSX a PUBC 

PUBX a 0, 

GO TO 280 
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c 


220 PLB)< » 0. 

PU0X * PLBC 

cauculation or ruow (given te pressure* at station uX 2 

230 ir(,NOT,CHOTST) QO TO 2A5 
C calculate MAXIMUM/CHOKEO flow 
I * LK8 

CHpKE • ,'TRUE, 

CALL floral 
CHOKE s .false, 
vmbSav* VMBC 

WACHOK* wcalc 

RATIO z WCALC/WRQST 

C calculate pressure at the T,E, STATION 

235 L » LX2 

IF(LK 2 ,tQ,LX 2 ,OR, SSDF J GO To 240 
WF s WCALC 
CALL FLOBAL 
WF ■ 0, 

240 1F{(PlBX;NE,0. .and, PLBC.QE.PLBX) ,or; 

• (pubx;ne,o. .and,. puac.Ge.puaxj) go Tq 242 

GO TO 245 

C CHOKED flow 

242 SCH0KE(LK2)=XCH0KE 
VMB(LK2)fVHHSAV 
GO TO 2505 

C FLOW IS NOT CHOK8D 

245 PL0 m PlBX 
pUB » PUBX 
call FLOBAL 

250 VMB(L)« VMBC 

C indicated flow adjustment error 

TERWF • (WCALC-WRUST)/WRQST 
2505 T£Xl2 ■ X2F<LF) 

TWr ■ Wrqst«CG 
JRET s 2 

IF(MODE,EO', (•!) ) RETURN 

251 ASSIGN 3flo TQ IRBT 
IF(ScH0RE<L«2> ,E0,XchOKEJ go to 255 
1 F<ABS<TERWF) .LT 7 TOLWFU) GO To 300 

C OBTAIN NEXT FLOW ITERATE 

IF(VNR<LF)’,NE.0, ) GO TO 252 
VNR(LF#1)««2,' 

VNR(LF*2)sJ25«WRQST 

252 WNEW ■ WROST 
VNR(LF*6)fO, 

CALL NEWRAP<WNEW»WCALC^WRQST,VNR<lF) > 

if(vnr<lf*6);eq;(-i.) ) wnewswcauc 

JF( ,N0T,CH0TST ,0R, WACHOK, GE.WnEW) GO TO 233 
WNEW 0 WACHOK 
SCH0KE<LK2)=XCH0KE 
GO TO 254 

253 IF(SCH0KEaK2> .EO.XchOKEJ DWDV(LK2)“0, 

UK2 ■ LX? 

ASSIGN 900 To iRgT 

254 RATIO « WN6W/WRQST 
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C adjust ruow IN TH6 STRfcAHUNE TABLE 
255 M B MLBILI 

CALL GF.TTX 
JA « J 

M B MUB<L) 

CALL GETlX 
JB s J 

c check to see if user wishes flow rate to be varied 

JX * JA 

258 LH 8 LHO 

260 IMLH.GE.LHE) GO TO 267 

ir(CHNAM(LH) ,'EQ,SLCHN( jXn GO TO 269 
LH B LH*LHNEXTILH) 

GO To 2^0 

265 IF { ,NOT, VARY(LH) ) GO IQ 280 
267 IF(JX,EQ,JB) GO TO 27o 
JX 8 JB 

GO TO 298 

C ADJUST FLOWS 

270 DO 275 J»JA|JB 
275 WIj) 8 W(j)fRATIO 
GO TO 2’0 

C DO NOT ADJUST FLOWS, PRINT COMMENT IF SUPER-CHOKEU 

280 1F(SCH0KE(LK2> ,Ng,XCHOKE) QO TO 7.9o 
1 F,(RaTiu;l 7,1. ) QO To 282 
SCHOKE<LK2)=0, 

GO TO 290 

282 write <6, 1280) R AT I Q , XJ ( LK2 ) , CHNA M( LH > 

290 GO TO IRET# (I35il70/900#300) 


C INDEX TO NEXT TRAILING EDGE* M0DE»1 AND TOLWF SATISFIED 
300 1F(LF,NE;LFF) WRI,TE<6i1300) TeXI2,TWF,T8RwF 
mode b 2 

310 lf ■ lf«nfcol5 
IFILF.GE'.LFE) lf^lfo 
IFiLF.NEVLFF) go TO 100 

c all flow adjustments are converged 
390 mode b 3 

c return 

900 LFF « LF 

1F<PDUM(6J -,£0,0, } return 
UTAB B LFO 

CALL TABPRT(6HCADJWF,X1F,lFE,iO) 
call TABpRT(iHW,W,NJ,10) 

RETURN 

1157 format (53H warning- BOTH CHNS CHOKEB - X 1 1 1 X 1 2 , X I iB , XI lA 

* 4F8,3,12H PSiWBiWA =|3FlO,4) 

1280 FORMAT<50H •#» CHOKINQ, WJLL NOT REDUCE FLOW SINCE VARTsF.SX.e 
oNRATIO = F9,6 i9H STA * F8,3,9h CHN * A6I 
1300 FORMAT<99X|F6,OiF13,4|:F11,4) 

END 
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*DtCK B«HS 

subroutine hrhs 

•GRHS-w COErriCIENT B AND RHS TERMS •URHS* 

C OUTPUT" 

C RHS(M)» RIGHT HAND SJDfc OF THE MATRIX EQUATION FOR DS2 

C B(M) s coefficient QF THE CURVaTJRE TERM 


C 

c 

c 

c 

c 


STATION TABLt 
INDEX" U«LOiLESTA 

SCHOKE* station CHOKE INDICATOR ( AD JWF , BRHS ;WR I OUT ) 

MCL s sharp corner indicator (BLDTbS) 

MCL s FIELD INDEX OF COnTrOl STREAMLINE (PTm 0VE*FU08AL ) 


COMMON /CHPATA/ 


1 

1 

& 

& 

& 


DIMENSION 

equivalence 

INTEGER 

COMMON /ALLCOM/ 


a 

& 


LOGICAL 

heal 

common /CB 

COMMON /bits 
COMMON /CCUHv 
COMMON /CDS2 
COMMON /CEDUmP/ 
COMMON /CFB / 


a 

& 


integer 

LOGICAL 


COMMON 

/CIPEX 

/ 

common 

/CMAX4 

/ 

COMMON 

/CMAXIT/ 

common 

/CPHIl 

/ 

COMMON 

/CPI 

/ 

COMMON 

/cprint/ 

equivalence 


COMMON 

/cptmov/ 

COMMON 

/crhs 

/ 

COMMON 

/CR 

/ 

COMMON 

/cst 

/ 

COMMON 

/CS8 

/ 

COMMON 

/CSS 

/ 


integer 

logical 

common /ctabpr/ 
common /ctolrl/ 


& 


common 

common 

common 


/CVM / 
/Cl / 
/ERASE2/ 


& 

& 

& 


XXa)iLNEXT{l),MLB(l) ,MUBai*PRlMU)i 
TYPELBUI.NAMELBm. lLB<lJ,FL3ai|SlLBU)i 
TYPEUB(1> iNAMEUBd) I lUB(l) ,FUB(1) iSlUB(l), 
VMBa)|UWDV{l),X2CL<l).SLSWI(l),MCLm » 
ANGTE(l) iPTTE(l) ,PSTE(1) ,'FGRTEa)|RGTEd) , 
ANGEXP(l) i‘^SQEXP(475) 

CHVLE(l)|ANGLEei> 

tSCHOKEfUwUv) , (CRVLE, AN®TE) , ( ANGLeiPTTb) 

PHIM,TyPELB,TYPEUa,ScHOKEtlI 
macha,psa,tsa.pta,tta# AXTA.’RGA.GAMA, 

MACHC|PSC,TSC,PTC,TTC. AX1C,'RGC,GAMC, 

UAXITjSCAlEa.TTEiCHOTST 

AXIA, AXIC.ChOTST 

MACHA(i) ,MACHC 

B(300) 

BITS, BLANK 
CURV(300) 

052(300 ) 

IGODMP 

L, MA,MB,Pl 8,PUB,WF,CH0KB^8UBS0 N, nk.plbc.pubc, 
XCHOKE, TaREA.VmBC, WROST^WCAlCi Q V< 8 ) » Q VP ( 8 ) i 
JSUM, VMLB sa 

XCHOKE 

CHOKEVSUBSON 

M, JiMU,MD, IST aG 
ES 2MAX,ZMX,RMX,DS2 MAX,LCNT 
MAXREFjNREFIN 

PHU(300) 

PI iTWOPl ,PI q 2,PIQ4,T0DE®,T0RAD 

POD< 6) |PDUM(1 o) 

iPRTES2,PDD) 

OPTMOV(2 ),NoDENS 

RHS(300) 

8(300) 

Sl.(300) 

S2(300) 

SSFML,SgEF,SSEANG,SSDF,SSFEND,SSFNDi, 

DSS(4 )|TSiC,RhOCiRHOCSS 

SSFML 

SSEF. SSDF 

UTAB 

tolrl,maxswp,clen,dtolri.toles 2 ,nswp, 

DSlDMPiOSlOpi,DTOLR2(A)iS61REFiTQLINR 

VM(300) 

2(300) 

AHEA(96),AREA0(96) ,DlSP(9IS>,PT{96 ) iLAMBDA( 96) , 
RH0(96 )*SqRTVV( 96),TS(96UTT(96) I VMS0(96) , 
VVKOKP(96)i 

yQA(96)»HSTA(96). RG { 96 > . C2CP ( 96 ) »FGR ( 96 ) 
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HEAL LAMBUA 

DIMENSION 65>2<96»»SDNQR(i(96) 

fcQUlVALENCfc ttS2 . VVKQkPV,(SdN3RM,RhOI 

common /IXOHig/ LHO*LHfcr lBDQ.UBDE, lTD*LTE,' LWOiLWE, LFO.LPE, 

& L0,LESTA,lS0,lSe#uDUM(6» . 

$ MO.NM, Nj.NfCOUSi MAXNJ;MaXOI,MAXNM,MAXUE, 

S IfcOiLfcfci lHO.L«Eii.RD 

COMMON /SlTab / W(i 28> il?2{l28) iSUCHN(128> 

inTeueh suchn 

dimension . ES2XK96) ,fcs2x2(96) 

DIMENSION 6S2SV(96), RMXS9(96>, ZMXgV(96) 

integer FARELUiF IELDiFREE,PRES,3Dl1Di TE 

LOGICAL eNTHY2» SSQL 

C SSoi, = SUPERSONIC POINT On THIS OL, T OB F 

data rARrL0/6HrARFLO/, FIELd/sMFIELD/, FREE/4HFREg/, 

A PRES/AHPRES/, SOLIO/5MSQlID-'i TE/2HT6/ 

C INITIALISE 

BDijhmY« 1./1024, 

C SUBSONIC/SUPERSONIC BRANCH SELECTION 

M ■ MLB(L) 

Call GETIX 

JA ' J • 

MAA B M 

M s MUB(L) 

call gettx 

JB * J 

MBB ■ H 

IF(JSUH,EQ,0) SUBSONs.TRUE, 

IF(SSEF) SUBSONs, false, 

IF(SCH0KE(L> ,NE,XCHGKE) go to 500 
IF(SSDF) SUBSONr .false, 

JbUM B JA*236»JB 

C cXtcUTE Flow balance 

500 call FLOBAL 

IF(TYPELBIL) ,EQ,Tb .OH, TYPEUBCl) .EQ. TE> jSUMxO 
1F( MA.tO.M8 ) call EHRORj 

C I think the above statement Can be REMOVEBD - I 14 75 
VMB(L)b vmbc 

C EVALUATE S2bDEVIAT10NS 

F « 1. 

IF( (TYPEL8(L) .EQ;S0LID ,AN0. TYpEJB(L) .BO’;SoLID) ,0R, 

« TYPELB(L»iEO, field ,0R, TyPeUB(L) iEO'.FIELD) FbAREAO(NK)/AREA(NK j 
IF(PdD< 6) .E<J,2, ) FSJ, 
c (Plane 2-d> 

DO 510 K«1,NK 

510 ES2(K)b (FbAREA(K)-AREAO(K) )/lAM80A(K) 

1F{ ,NOT ,AXI A) GO TO 55Q 
C (AXISYHMETRIC) 

K B 2 

H « MA*1 

520 eS2(K)« 6S2(K)/(TW0PI*R(M) ) 

K • K^l 

M B M*l 

IF(K.NK) 520,520,550 
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C evaluate maximum plow balance error, F.S2«X 
5)50 lf(L.EQ,L0) ES2MXaO, 
no 560 K»i,NK 

560 E52MX « AMAXi(ES2MX, ABS(ES2(K ) ) ) 

c: get actual MaX value of ES2 { WITH SIGN J 

C get Z and H at max ES2 

call MINMAX ( ES2i li NK, ES2MlN* MlNPOg# ES2MAX* MAXPOS ) 
MRZPnS s mA t ( MAXPOS • 1 ) 

IE ( ABS(FS2MIN) ,LT, ABS(ES2HAx) ) GO TO 565 

gSjMAX B eS2mIN 

MKZPOS = MA + ( MINPOS - 1 ) 

565 RMX « R(MRZPOS) 

ZMX r Z(MRZPOS) 

C SAVE MAX VALUES AT EACH STATION 

ES2SV(LCNT) a ES2MAX 
RMxSV(LCNT) • RMX 
ZMxSV(LCNT) «• ZMX 
C TEST FOR LAST STATION 

LCWK • L ♦ LNEXTIl) 

IF ( lchk ;lt. lbsta ) go To 575 

C riNU MAX VALUES FROM ALL STaTIOnS 

CAUL MINMAX ( ES2SV, Ij LCNT, ES2M1N, MiNpOSi ES2MAXi MAXPOS ) 
MHZPOS a MAXPOS 

IF ( A0S(ES2MINJ ,lT, ABS(ES2MAX> J GO TO 570 
ES2MAX = ES2M1N 
MRZPOS = MINPOS 
570 RMX B RMXSV(MR2P0S) 

zmx « Zmxsv < mrZhos ) 

575 IF <PRTES2 ,LE, 2,) GO TO 6oO 

IE (XKL) ,LT,PDUM(8),OR,Xl(L)tGT,pRTESIJ GO TO 722 
LMXl = L 
LMX2 a L 
NKXl s NK 

CAUL MOVE (l,ES2,bS2Xl|NK,l) 

IF (Xl(L) ,EU,PDUM(0)) WRITE(6,1661) 

GO TO 660 

600 IF (PRTES2;NE,2, ) GO TO 722 
DATA ENTRY2/F/ 

ES2MXoaO, 
no 605 Kal.NK 

605 ES2MX0B AMAXKES2MX0, ABS<ES2<KM ) 

IF (ENTRY?) GO TO 6\Q 

ES2MX1B ES2MX0 

ES2MX2a ES2MX0 

LMXl a L 

LMX2 a L 

NKXl = NK 

NKX2 X nK 

CALL MOVE (2,ES2,ES2X1,NK,1, eS2 , ES2X2 , NK^ 17 
ENTRY2 - .TRUE, 

GO TO 6^0 

610 1F(ES2MX0.LE,'ES2MX1) GQ TO 63Q 
ES2MX2 a ES2MXI 
LMX2 a LMXl 
NKX2 * NKXi 

call move (1,ES2XI,ES2X2,n*<X1,1) 

ES2MX1* BS2MX0 
LMXl a L 
NKXl a NK 
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call M 0VEa»eS2 ,|ib 2¥l»NK,i) 

GO TO 6^>0 

A30 IF <ES2MX0,LE,FS2MX2> 00 TO 650 
Eb2M^2* ES2MX0 
LHX2 = L 
NKX2 = NK 

call M0VE( tigS2,802x24NK, 1) 

650 IF(M0B,NE,NM} go TO 690 
WRITE <6^1661) 

660 WR1TE(6i1660J XKLMXD 
M s MlB<LM* 1)-1 
IF(LMX1,E0;L j M = MA-.X 
DO 670 K«i,NKX1 
M M 

670 WK1TE<6»1670) M, 

& Rdi) iRHS(M»,DS2(rt),2(M>,R(l1)vPHll(M) iCURV(M) ,Es2XUK) 

IF(LMXi,EQ;LMX 2J 00 TO 690 
LMXi = LMX2 
NKXl s NKX2 

call MOVE <1,ES2X2,eS2X1,nKX2,1) 

GO TO 660 
l66l FORMAT<lHl) 

X660 format <//9H stations, F«, 3// 

& 5XilHMi5xilHB» 10X,3HHH5,9X.3HOs2,9X,lHZt lOXi 
& 1 HRi 10^,4HPRI1,7X,4HCUHV,7X,5MES2X1/) 

1670 FORMAT ( IXi I 6 , F li , 5 j 2 ( 3X , F’ , 6 ) , 4 » FH*. 5 ) , 3x , f9 , 6 ) 

690 COKiTiNUt 

C#*«*CALC COEFlClfcNT B ANU HHS qF MatRIX SQOATIoN ^OR DS2 

C SET SUPERSONIC OL INDICATOR 

722 SSOL * .false, 

c loner boundary 

C NOTE™ MA»MLB{L)*1 FOR A STAGNATION P/INT 
M * MLB(L) 

RH8(M)« 0, 

K . 1 

M « MA 

RHS(M)s 0, 

QGaMP • FGR(1)/U,*FGRU) ) 

BETSQP = li«VM(MJ*VM(M)#QGAMP/(R6(l>*TS(li ) 
fl(Ml « BETS0P«(S2(M>1I-S2<M) )/WOA(l) 

C IS FIRST POINT AN lSTAGs3 PT AND THE FIRST OF A DOUBLE POINT 

IF<WSTA»2) ,NE,'WSTA( JM GO TO 724 
IF(TVpeLB(L) ,N fe, FIELD) CALL ERRORl 
C treat first PT AS DUMMY pt AND 2ND PT AS ISTAGT3 PT 

RHS<MJA ES2(i)-ES2<2) 

B(M» » bdummy 

K s K*i 

M s M*1 

call getix 

ISTAG s 3 
CALL SAVIX 

RHS(MJ* 0, 

B(M) A BqUmmT 
GO TO 756 

C SPECIAL boundary TYres 

724 IF( (TYPELBIL) .NEVFARFLD ,AND, TyPElB ( L ) J NE . FREE .AND, 

& TYPELBIL) ,NE;PRES) ,0R, < nODENS ,GE NR|F fN ) ) GO TO 756 
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S(R) ■ ;5«<AREAe(2}.AR6A0(l) )#BETSQP«(82iM4l)«S2|Pin 
RHS(M)i AR6A(2)«AREA0(2) • AREAU ) *ARBAOU ) 
lP(VMWBS(3VNE70t) 

g •tAREA0<3).AREA0U))*aETS3P»;5»(VMLBSQ/|VM(M)*VM(+O)-l, J 

GO TO T56 

c in^’erior Pdl'SiT 

T25 8(B) • 0. 

|F(MM,NE7M) go to 786 
TSaVGM* V5*(TS(KB)*TS(KM1>) 

0(JAMH • FGR<KM)rfl,AFGR<KM) ) 

BETSQM* l.«VM(MH)«VM(MMU»QGAMM/(RG(KM)»TfiAVGM) 

RHOVM • 75»(HQA(KM1|+WQA(KB)) 

B(M) • 75tBeTSaM*(S2(MM),S2<MMiJ )/«HOVB 
726 ir(WSTA(K*ik;EQ;irfSTA<K)) GO TO 728 
TSaVGP* V5»(TS(K)*rS(RAt) ) 

OGAMP « FGR(K)/(i,*FGR(K) ) 

BETSOP* i;»VM(M)tVM<M*l)«QQARP/CRG(K)#T8AVQP) 

RHOVP ■ 75»(WOA{K*l)*HQA<K) > 

8(B) ■ ;5«BBTSQP#(S2(M*i)»S2<Mp/RH0VP * B(M) 

728 ir(MM,E07M .AND. 8 < M ) *81 H.l ) , lT J 0 . ) SSO^ATTRUE. 
ir(WSTA(K*$)7EQiWSTA(K)) GO TO 757 

735 RHS(M)a(ARgA(K«U*AREAQIK«U«AREA(K)«AR8A0(K) )/(MSTA(K*t)-WsTA(K) ) 
& *(ARiAfKH)«AREAQ(KH)«AREA(KMl)«ARBAO(KMl))/(NSTA(KM)»wSTAlKH 

A D) 

756 KMl « K 

MMl a M 

KM s KMt*l 

HM ■ MMt*l 

GO TO 768 

C double point n,E7 W<Kti)aH<K)> 

757 RHS(M)a BSE < K ) a£8 2 ( ) 

760 K a K*t 

M a M*1 

IF(K,UT.NK) go to 725 

C UPPER boundary 

C note- MBAMUBfL)"! FOR A STAGNATION POINT 

H a MUB(L) 

RHS(M)a 0. 

M a MB 

RHS(M)a 87 

QGaMM « FGR(K)/(|,«EGR<Kn 

BETSOMa i;.VH<M)tVM<M)#0GAMM/(RQ(K)»TS(KM 

B(M) ■ BETSQM»(82(M)’'52CM-1> )/W0A<K) 

IF(8(M) .BQ'.O;) 8#M)fB0UMMY 

c double field BOJNT 

1F(WSTA(KJ ’iN|.WST,A{k-1) ) GO TQ T9o 
ireTVPEUBItJ.’NeiRIELD) CAI.L ERRqRI 
B(M-1)b BOUMMY 
H a M-t 

CALL getix 

ISTAG a 0 

call SaVIX 

c special boundary types 

790 1F((TYPEuB(L) .NEVPRBS »AND| TyPEUB(L);n8.FRBE ,ANDi 

g TYPEUBtt)7NE;EARFLD> ,OR, (NODBNS’.GEjNftEFlN)) QO TO 800 
8(B) a 75»(AREAO(K)-ARgAO(K-l}}»3ETSOM*(52<M)-S2|M-in 
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ARf A(K«l)«AREAO(K-i) - aREA< K ) ♦AR( AO < K ) 
600 If SS0u*,TRU6. 

c., ,;.eNB CALC or b and rhb 

If (SSOL ;aND. SUSWKU.EQiO,) SLSWKUflV 
RETURN 

end 


( 
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cjcioocs ocj D n 


•DtCK NEwRAP 

SUBROUTINE NEWRAP< X lEi V ) 

•NEWRaP outside ITIRaTION procedure 9NEMRAPP 

C TO BE USED WHEN JNNEH SELF CONVERGENT RELATIONS EXIST, 

input* 

X > ABSCISSA 

E - error in the orqinate 

V * STORAGE for A 12 ELEMENT VECTOR 

input, first entrv onlt 

vm * ctr s 0, 

v(2) s DEDx E Estimates the slope qp the curve 

(X2=X1*E1/DEDX IS THE FORMULA FOR THE SECOND X) 

(E/DEDX) IS US^U TO reduce DXMAX DURI'NO THE ITERATION 
C V(3) « XMOVE 

C ABStXMOVE) s MAXIMUM DELTA X 

c sign<xmove)» direction To the branch or the curve with slop 

C OUTPUT- 

ext next X estimate 

common /CN6WR / DEDXP(2UDXP(2),DX,WS 

dimension V(12J|Q(12I, xP(2),eP<2) 
eOUIVALENCe (cTR,Qa)>t (dEdX, Q( 2))| ( XMOVEf Of 3 1 ) » 

1 (DXMAX, 0(5) ) , (DXPREV,Q(6)>. f OPS I GN • 0 ( 7 > > . (SPAN, 318) 

2)i (XP,0(9)), (EpiO(ll)) 

LOGICAL SPAN 

DO 50 I * lil2 
50 0( I ) « V(1 > 

IF<CTR,GE,30, ) CALL ERRORi 
IF(CTR.NE.0, ) GO TO 200 

C FIRST entry 

DX s -E/OEDX 
DXMAX ■ ABS(XMOVE) 

DXPREVs DXMAX 
OPSIGN. 0, 
span ■ ; FALSE, 

60 TO 520 

C SECOND and successive ENTRIES, EVALUATE DEDXPII) AND DXP(I) 

200 WS > 0. 

DO 250 l»l,2 
DXp( 1 )s 0, 

IF(l,EO,lJ GO TO 220 
1F(CTR,LE.1, I GO TO 27Q 
lF(WS,EQ':0i ) GO TO 220 

1F(, not, SPAN ,OR,' (E»Ept2) ,gT.O; n GO TO 850 
c |F(,N0T;SPAN ',‘OR. SAMESIGN{E,EP(2) I > BO NOT USE POINT 2 

220 DE * E-gP{l> 

DX 8 X*XP(I) 

1F(ABS<DE) ',LT,ABS<DX)/1,Ei5) go to 250 
fr(A8S<DX);LT,ABS(DE)/i,6l5) GO TO 250 
DEDXP(I)* DE/DX 

C CHECK SIGN OF DEDXP(I) 

1F(DEDXP(1 )«DEDX',‘LT,0, ) GQ TO 250 

DXP( I )8 AMAXK-DXMAX, AMlNl(-E/DEDXP( 1 ),BXMAX) ) 

WS 8 ws*i; 

250 continue 
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o rj o 


270 if(Ws,ne;o;) go to «oo 

TME DEDXP HAVE INCORRECT SIGNS 
TAKE MAX JUMP TOWARD THg CORRECT BRANCH 

MATBE OESTRBD ordinate is above/below THB HAX/MlN QF THE CURVE 
350 !F(0PSIQNJ 360»3S0i355 
355 DXMAx ■ ;5»DXMAX 
360 OPSlQNir -IJ 
DX • XMQVg 
GO To 520 

C REDUCE MAX QX If OiRgCTlON Of iTgRAriON IS CHANGING 
AQO IF(OPSIGN) 4|0i490i490 
410 OXM^X « ;5*dxhAx 
490 OPSIGN* 1, 

C PEDICT NEXT AbSCISSai PBDXP HaVe THE CORRECT SIGNS 
5Q0 DX «(DXP{l)*DXP<2))/WS 

D^^HAX * AMINi(DXHAX;abS(XmOVE)) 

c •dxmaxiUE',dx,l6;qxmax 

520 DX « AHAX1(«DXMAX«AHIN1(DX«DXHAX>) 

C SAVE certain goodies TO USE FOR FUTURE ENTRIES 

600 OXHAX • ;25«0XMAX ♦ , 75* AM I Nl ( DXM AX » AMAXl {DXPREV , ASS ( 2 , #E/DEDX ) J ) 
DXpREVa ABS(DX) 

XP(2) * XPIl) 

EP(2) » EPUl 
XP(l) • X 

Epai « e 

1F(EP<i)*EP(2) ,UT,0,) SRAN«,TRUE. 

CTR « CTR*1, 

C SET X and return 
X a X4DX 
DO 960 IA1*12 
960 VU) i QM> 

return 

END 
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•DECK STaLOO 

subroutine STAUO0 

•STALOO LOOP through STATIONS AND EXECUTE PLOBAL PSTALOOP 


C 

C 

C 

c 

c 


c 


c 

c 


station Table 
index- LtLOjLESTA 

SCHOKE. station cROKE indicator ( ADUwF,BRHS,'WRIOUT) 

MCL * sharp corner INDICATOR (BLDTbS) 

MCL • field INQEX OF CONTROl STREAMLINE (PTMOVE,FLO0AL » 

COMMON /chdata/ xi u ) , lne xt ( 1 ) , ml3 ( 1 ) ;mub i 1 7 i PR 1 M * 1 > t 

1 ■ " - ■ - 

1 
A 
& 
i 


DIMENSION 

equivalence 

INTEGER 
COMMON /CF8 


TYPElBU) ,NAMELS(l),lLB(li ,FLB(i)|SlLBU)# 
TYPEUBU) ,NaMeU 9<1), .FUBdliSlUBdli 

VM8<i),DwDV(U,x2CL<l),SLSWm),MPLa)i 
ANGTECl.) ,PTTE<l),PSTE<li;FGRTE<l)|RQT6d»i 

ANGEXPU)iBSQEXP(475> 

crvleU) iangleU) 

J SCHOKE r D WD V >.( CR V lE.ANGTe );(ANGL6 I RTTfc) 

PRlM,TTPELB,TYPEU3,SCHONEfl7 


1 

« 


LOGICAL 

COMMON /IXORlG/ 


, MA, MB, plb, Pub, wF, C hoke. sUBSoN, nk.plhc.pubc, 

:HQKEi: TAREA.VmBC, WRQST.WCAlC. QV(8)iQVP(8)/ 
5UM.VMLBSO 


tt 


dimension 
equivalence 
common /cb / 
common /CFB2 / 
LOGICAL 

common / CMAX4 


common /CSTAlO/ nsspts 

begin loop THROUGH STATIONS 
CHOKE s .FALSE, 

JSUM ■ 0 
L * LO 
lcnt • 0 
NSSPTSs 0 


L , 

XCHOKE., I « c 
JSUM, VMLBSO 

choks.subson 
lho^lhe, lbdo.lboe. lto;lte; lwo.lwe, LFO.LFE, 

LOiLESTA, lQuM(0). 

MO,NM, NU.NFCOLS, haxnj;maxql,maxnm,maxl£, 

LEOlLEfci lROiLREiLRD 
LIMITS(24) 
aiMlTS,LHO) 

B(3Q0) 

RASSl 
P ASSl 

/ DUMAX(4), lCNT 


C CALL BRHS and FLOBAL 


410 PLB 

■ O'. 

PUB 

s 0, 

WP 

* o; 

■ LCNT ♦ 1 

lcnt 

call 

BRHS 

c count 

number of supersonic Points 

IF(SLSWltLJ,NE,l7> SO TO 45 q 

HA 

■ mlb(l)*i 

MB 

■ MUB(L)«1 


DO 420 M*Ma,MB 

420 IF(8(M) ,LT',0p NSSPTS»NSSPTS*1 


C INDEX TO 
450 L » 

lFtL.LT 


The next station tI,E, ORTHOGONAUi 
L*LNEXTtL J 
LESTA) go to 4iP 


PASS! • .FALSE, 
RETURN 
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•DECK STCWl 

0VeRuAY(STQ,2,2) 

PROGRAM STCWl 

C WRITE THE OVER.AU STC UATa RECORD, KEV(S)aA< 
call WRIA 
call WRIOUT 
call WR10DY 
call WRIATP 

return 

end 
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DECK USECDW 

BUOCK DATA USECDW 

USECDW RBPtACE ST6M USE CaROS 

COMMON /ERASES/ WDUM(400) 

COMMON /CPSM / RSH<769) 

END 



•DtCK BUTBBL 

subroutine BI,TB0L 

CBUTBai, build boundary layer tables 

COMMON /BLDTa / BUNAMfciLOwtRi 1BTYPE»N1,NI»CAPX1 
integer BUNAmE 

LOGICAL lower 

COMMON /BlDTAi/ BNAMSV 
IN^EGE^^ BNAMSV 

COMMON /IXORIG/ lHO,'.LHEi LHTO.LBDE. LT0;LTE,’ LWO.LWE, LFO.LFE, 
** IPiLESTa, LSO.LSE, LDO.LDE, LDUM(A), 

« MO,NMiNJ,NFCOLS,MAXMj»MAXOL.‘MAXNM,MAXLfc| 

<» leoilee»lro,lre,lrd 

C STATION table 

common /CHDATA/ Xl{i)jLNExT(l),ML3a>iMUB{lTtPRIMll), 

• TYPELB(1).NaMELB<1)»ILB(1J,FLBU) 

common /ERASE2/ I U 100 » , SW0L ( lOO ) , ZW< 100 J , RW ( lOO ) i DSTKUOO W 

• BDSTR(IOO) .VE(l0n>,MACHUt)07tDUM{700) 

dimension LEDEXai.LBZKl) 

equivalence ILEDEX^TYPElB), (lbzi.mlbv 

c boundary layer table 

C INDEX^ LD*LDO,lDE»-- initially 1,0 

dimension BNAMEU) ,LBlNxT( 1) ,NSEP(21 iSWREra) ,SIGN<1) ; 

• BW(i),DSTaR<1).DDSTAR(i> 

integer BNAME 

equivalence tBNAMEiXl) ,(LBUNXT,LNEXT)\(NS eP,MLB), 

• fSWREFiPRlM) , (SiGN.TYPELBi , ( SW , N AMELB > » 

« lUSTARi ILB) , (DDSTAR iFLBI 

COMMON /BLSEp / NSLOC 

COMMON /REBL / flESTSL 

LOGICAL HESTBL 

COMMON /CPRINT/ RDUMM ( 6 ) , pDuM ( 20 ) 

COMMON /CTaBPR/ U^AB 
COMMON /9L80Y / lBLB(60J 
INTEGER UPPER 

INTEGER BNAMC 

LOGICAL enthyi 

DATA ENTRYI/T/ 

data UPPER|L0WR/5HUPPEH»5HL0RER/ 
data SWSAVE/0,/ 

IF( RESTbl ) GO TO 1111 
GO TO 1 

C RESTORE TABLES 

1111 NUM ■ LDE-^LDO*! 

NMOVE ■ LESTa^LFO*! 

CALL MOVEUiXKLFO) ,XiaDOl,NMOVE,l> 

LFO s CDO 
LESTa * LESTa,NUM 

LO « L0«NUM 

LFE i L0»1 

LOO « 1 

LOB 8 0 

R^STbLb ,^FaUSE, 


C RELOCATE flow ADJUSTMENT AND STATION TABLES 


1 NUM ■ 3*(NI«N1H>*6 
MAXT 8 LESTa*NUM 
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1F( (MAXT-UHO) ,GT,MAXt,ti ) GO TO 1000 
LFQNEWf LFO^NUM 
NMOVE « UESTA^UFO*! 

CALU M0V6U,Xl(LF0>iXlJUf QNeW),,N*10Ve,i» 

UI3 ■ LDi*l 

1F( lDE J ?i2,5 

2 UDO ■ UFO 

UD * UDO 

UDE * UDO*NUM»l 

GO TO 6 

5 LDE ■ UDE^NUM 

6 UFO * LFONEW 

U^STa ■ MAXT 

LO s lO*NUM 

UFE « U0»1 

L3LNXT<UD)* ud*num 

c Sequence to set swref 

SWREF(UU)« o; 
bNa^c • bdname 

LB S LRF<BNANC) 

IF{ UB.NE.O ) go to 18 
c collated BOUNDARV-sCHECK For uE 
BNAMC » 8NAMSV 
LB * LBF(BNAMC) 

18 |F| UEOEX(LB) ,EQ|'0 ) GO TO 20 

IVl . 1 

\M2 * aeUBX<L8)-LBZi<LBM/3*l 

SWrEF(LD)* BARCS(BNAMC| IVli IV2) 

GO TO 21 

2 0 IF( ,NOT;lOWER)SHHEF(LUMSWBL<NI) 

21 BNAME<LO)«BONAH6 

SlGN(LD)s «1, 

IF( LOWER > SIGNtLD)*!, 

NSEP(LD)* 0 

IF{ nSLOC.NE.O ) NSEP(LW)»UD*3«(NSlOC-N1^1)-3 

c move bl parameters to table 

30 DO AO LD1«N1,NI 
' SW(LD)« SWBLTLDIJ 
OSTAR(LD)? DSTRaui) 

OOSTAR(LD)fODSTR(LDl) 

LD « LD#3 
40 CONTINUE 
GO TO 2000 

1000 L^P « Upper 

IF( lower ) LUPsLQWR 
write (6,1001) LUP,BDNAME 

1001 F0RMaT(// 2X,48HTABLE SPACE EXHAUSTED^, BOUNDARY LAYER DATA FOR , 
» A6i2X,8HB0UNDARS»2Xf A6*2 Xi9HnOT SAVED//) 

DO 999 LL»i#58i3 
IF( IBUB(LL>?EQiO ) GO TQ ZqOO 
1F( IBLBiLL) 7EO;0DNAME ) lBi.B(UL*l)sO 
999 continue 

2000 IF( PDUM<15> ,E0;Q, ) GQ TO 2001 
IITAB I ldo 

call TaBPRT(6HSTAUL.T,X1,leSTA,6) 
call TABPRT(3HBLBiBLB|6q,10) 
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2001 ENTRYl* .’FALSE, 
RETURN 
END 



n o o n n o 


•UfcCK LESTSQ 

SUBHOUTINE l,ESTSO< X, Y, I a, iB,MOC,NS, DY) 

•LtSTSQ IST/ 2 ND ORDER CURV FIT 9y LEAST SQUARE DgV •UESTSO» 

• VERSION 2 

• MO ROTATION OF AXIS 

• automatic reduction of ns and no near the end PTS 

dimension mO)iYUp)iDY(lO) 

input^ 

X(1).Y(1),1s1A,1B are entry coordinates 
N oc « OROfcR OF Curve fu * i, s2 or s 
c NS • NUMBER OF POINTS INCLUDED IS EACH LEAST SQUARE FIT 
C MINIMUM NS IS ?NO*NO*Ii AlSO* NS MUST BE ODD. 

C OUTPUT. 

C DY(I) » DEVIATION OBTAINED FROM THE CURVE FIT 

COMMON /ERASE / 0(3).A(3,3) 

MIS » CNS-D/2 

lAA ■ TA*1 

IBB « IBtil 

OY{ lA)« 0, 

1F( IaA.GT, IBB) GQ TO 160 
DO 150 l*IAA,IBB 

C initialise To ZeRQ 

DO 110 Usl|12 
110 B< J)*0, 

c SET UP Matrix {a)IX)^(b) 

A(lil)*NS 

MI * MIN0M-IA,MlN0(M|Si 13-1 U 

NO * MlNO(NOCiMItl) 

JA « I-MI 

JB * r«Mi 

DO 120 JiJA.jB 
XP«X(J)wX(I) 

YPsY( J).Y{ 1 ) 

XP2*XP#»2 

A(li?)>A(ii2)*XP 

B(1)«B<1)*VP 

A(2i 2)«A(2|2)*XP2 
B<2»=B<2>*yP»XP 
1F(N0.2) 115,l20ill5 
115 A(2i3)*A(2|3)*XPa«XP 
A(3|3)*A{3,3i*XPa»«2 
B(3 >sB<3J*YP«xP2 
120 continue 

A(2»1)*A(1i2) 

IF(N0^2) 125,130i 125 
125 A(li3)»A(2i2) 

A(3i1)«AIi,3) 

129 A I3|2)*A(2|3) 

130 call SIMEQ(N0,A,B,3J 

DY(l)aB(lJ 
150 continue 
160 DY(lR)i 0. 

return 
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END 
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•UfcCK RBWAKE 

SUB«0UT1NF «8WAKf 

crbwake adjust hake table for TE BL 

COMMON /CHPATA / X2wU)rLwMEXT»l>iSlW(4T) 
dimension DST(I) 

EQUIVauENCB (DST^S^W) 

COMMON /CPI / PIiTW0PIiPIq2,PI(S4,T0DE6.'T0RAD 

COMMON /ixORiQ/ LHOfLHE, lsdo.lbdb. lto,lte; lwoawe, LFO.LFE, 

1 iQiLESTA, LSO.LSB, LD0,LD6 i LDUM(4), MO.NM, NJ, 

2 ■ NFCOLS* MAXNJ.MAXDLiMAxNMiMAXLE, L^OiLfeE, 

3 LMOi'LHfe,LRU 

common /TETAB/ JiTerXJT2(l6),ANGT£( J6),DSTTBU6)iD0STTt<i6); 

» BTEa6UZTE(l6) 

» ,LWER(16> 

logical lwer 

IF< ITEigO',0 > RETURN 
DO 100 l*liITE 
X12 « XIT2(I> 

IF<XI2,LT.0, ) GO TO 100 

C SEARCH FOR MATCHING XI2 
12 « I 

10 12 ■ 12*1 

IFn2,QT;iTEl GO TO 20Q 
IF(X12,NE.XIT2(I2)) GO TO iQ 
XIt2(I2)» •1. 

C find match in wake table 

LH X LWO 

15 IF< LW.GT.LWE J GO TO IQO 
IF< XI2iEQ;X2W<LBn GO TO 2 q 
LH * LW*LWNEXT(L«) 

GO TO 15 


C 


adjust wame table 

20 IKL a 12 

IKu a 1 


100 

300 


1F< ,N0T;LWER(I) J lKUal2 
IFl IKLiBOilKU ) IIL*I 
ANGCU ■ ANGTe< IKU»*DDSTTE( IKU) 

RCU ■ RTE( 1KU)*DSTTE(1KUUC0S( anqcui 
ZCU ■ ZTf I1KUJ.D8TTE(IKU)»SIN(AN6CU> 
ANQCL a aNGTE(IKLJ-ODSTTE(IkL) 

RCL ■ RTEUKL)pDSTTEnKL»»COS|ANGCL> 
ZCL p ZTEUKUfDSTTEl IKLUSIN(ANGCu 
ANQM a ,'5«( ANGCU* ANGCL) 

DR21 a RCU-RCL 
DZ21 ■ ZCU-ZCL 
THK a DR21**2*PZ2l*^2 
IF( THK,EO;0, ) SO TO 100 

dang a ArAN3(0R2l,DZ2lrANGM)>Pl02aANGH 

THK a S0HT(THK)«C0S(DANG» 

DST<LW*4J# TWK 

continue 

RETURN 


200 WRITE 16,2011 

201 format (//2X,29HWARNING-a MJSSING TB AT«»X 1 2* ,F12 ,^6// ) 
GO To 300 

END 
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n o o 


•DECK SIMEQ 

subroutine SimEQ|NN| A iBtHP) 

CSIMEO PRO NO F3494A 

THE IQUA710NS WHICH ARE SOLVED ARE AX4B; THE MATHJX 
SiMEQ simultaneous EOuAtIONS 

A and the vector b are destroyed; for printout or 
c THB matrix to be solved set mP not equal to zero 

c NN IS THE NUMBER OF Equations 

dimension A(3«3}>B(3) 

25 DO v<0 K»i,NN 
30 PsA(KiK) 

35 ASSIGN 85 TO MT 
40 DO 55 1*K,NN 

45 lF{ABStP).ABS(A<l,K))) 50,55.55 
50 PaA(I,K) 

52 ASSIGN 65 TO mT 

53 L?I 

55 continue 
60 GO TO MTad5,85I 
65 DO 80 JsK.NN 
70 psA(K,J) 

73 A<K, J)«A{LiUJ 

80 A(LiJ)«P 

81 P^BIK) 

82 B(K)sS(L) 

83 B(LlsP 

85 8<K)«8<K)/A<K,KJ 
IF(K«NN) 90,145,90 
90 L4K*1 

DO 100 J*Li^N 
100 A(K,J)«A(K«J)/A(K,K) 

DO 140 IpL.NN 
IF(A(I,KJ) 120i140,120 
120 DO 125 JpL.NN 
125 A< Ii J)»AtIiJ)-A( I,K)*A(M, j) 

140 B( I )>Bt n«A< I ,K)fB(K) 

145 L4NN.1 

DO 170 KK»1,L 

KpNN.KK 

P»0i0 

DO 165 J«K|L 
165 P3p*A(K#U*i)tB{ Jfl) 

170 B(K)aB<K)«P 
1999 RETURN 
END 
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o o 


*UbCK SAB 

SUBROUTINE SAB(BNTRV) 

CSAB MAIN subroutine FQR BoUnDaRY LAYER CALCULATION 

integer entry 

ON ENTRY*FIRST, save BjSa On TAPE4 
ON entry*last, restore B,S2 

common /BCOLLT/ zbcol 

COMMON /BLDTa / BONAME|LOwER, IBTY»EiNI,NUCaPX1 
integer BUNAHE 

logical LOwfeR 

common /CB / 8(300) 
common /CBITS/ bits, blank 
common /CS2 / $2(300) 

common /IX0RIG/ LHOi'LHE, lbto.lbde, lto*lte; LMO.L'^E# LFO.LFE, 

» LOiLESTAi LSO.LSEi LDO.'LDE* L0UM(4)f 

ft MO,NM,Nd,NFCOLS,MAxNJiMAXOL;MAXNM,MAXLE, 

a LEOaEE»LRO,LRE,LRD 

common /ERASEB/ X11(100)iSM(100)>ZW(100)iBW(100)iDUM(200)i 
» VtUOOlfDuMKSOO) 

COMMON /ALLCQM/ DUM2( 5 ) »AX I A . DUM3( l4 ) 

logical AXIa 


GO TO <l42|45) , ENTRY 

1 REWIND 4 

WRITE (4) (8<I)»I=i»NM),(S2(I),l»l»NM) 

c SCAN Tables tq set ni 

2 ibtTpe* 1 

1F< RW(i}.EO,0 ,AND, AXIA ) 18TYPS«2 
GO To (5 ;b) , IBTYpE 

5 DO 6 I«1JNI 

IF( vEdJ.Lt.O, ) GO TO 20 

6 continue 
IBTYPE. S 
N1 ■ 1 
GO TO 21 

8 DO 10 I*liNI 

IF( RWUI.GT.o, I GO TO 12 

10 continue 

RETURN 

12 N1 I 1-4 

1F( Nl.EO.O ) Nl«l 
GO TO 2l 

20 N1 >1 

IF( VE< 1*1) ,LE,0; ) Nl»Nlal 

21 1F{ Z0COL.EU;0ITS ) GO TO ^0 
C CHECK FOR Z ( N I ) , GE ,'ZBCOL 

IF(ZW(N1J .fiE.'ZBCSL) GO TO 3 q 
NN t • Nl 
DO 25 I^NNliNl 

IF( ZWUJ.GE.ZBCOL ) OQ To 30 
Nl a Nl*l 

25 continue 

call ERR0RK(6hSAB ) 

c calculate bl for boundary-- <bdname> 

30 call SABBL 
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C insert smoothed PATa into /BLTAB/ 

40 call bltbbl 

80 TO 90 
49 REWIND 4 

read <4J (B(I),Ixi;NMU(S2(I),I.l.NMI 


50 RETURN 

end 
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•DECK SABBL 

subroutine sabbu 

•SAUBt 

COMMON /CBl^S / BlTs , blank 
tQUiVAUENCb CHlTS»l0lTS)i ( BUAnK , IBLAkjK] 

COMMON /ALICOM/ M ACM A j OUMC A ( 4 ) , AX I , DUMCB ( l4 ) 

REAL MaCHA|MACH0,MaCM0S 

UOQICAL AXl 

COMMON /BLDTa / BONAMfctUOwER, lBTYi»E|Nl,Nl^CAPXl 
logical lower 

common /erase?/ BSTAR<10O),SW(lOO),ZW(l00),qW(lO0JiDSTR<100); 

1 DDSTR(iOO)iVE(lOO),MACH(160IiMACH90aOO),CP(100Ti 

2 POPT(lOfl) .Pw(lOO) ,R6XP<10b) ,PR(100) iCAPX(lOO) 

DIMENSION Xw<1)|YW(L) 

equivalence UWi'XW)i(RW.Yw) 

REAL MaCH.MaCHSQ 

COMMON /VISCOS/ TREr.MUReFiSCON 

real muref 

COMMON /CGRAV/ CG 
COMMON /BLSEP / NSlOC 

common /IX0R1G/ LHO^LHEf lbto.lbte, lto;lte; LWO.LWE, lfo.lfE, 

5 L0,LESTA» LSQ.LSe, LOO.LDf. LDUM<4>, 

6 mo,nm,nj,nfcols,maxnj;maxol;maxnmiMaxle» 

4 LEOiLEEf lPOiLREiLRD 

COMMON /SABCHN/ CHNSaB 
integer CHNSAB 

c table or convecteo properties 

c INDEX- LT*LTO.LTi 

CH « CHANNELNAME 

LTNEXTb index increment TO THE NEXT CHANNgL 
LPSI • RELATIVE LOCATION OF PSI LIST 

NPT « no; of PSI, TT, PT AND RCU VALUES 

LTT « relative location Of TT list 

UPT ■ relative LOBATION of pt list 

LHCU s RELATIVE LOBATION OF RCJ LIST 

COMMON /CHDATA/ CH ($ ) , L TNE XT ID , NPT C 1 ) , LPSI ( 1 > ♦ UTTU ) ,LPT {1 > . 

1 LHCuUIf 

2 CRG(i),CPGJa>,C2Cp(l) ,0 GaMC1),FGTIi>a*‘GP(1); 

3 FGR(i),AREAt8{405> 

integer CH 
dimension XCHdJ 
equivalence (CHjXCH) 
dimension LHNEXmi rTTT(l),PTT<i) 

equivalence (LHNEXT.lTnE^T) ,{TTT, AREATBiSn# (PT^iAREATB{4) ) 

DIMENSION REX(100> iTH£Ta(100)iDElTA{ 100) iPUOO) .FldOO* I 

1 F2(100I rF3(100),CP<100); TSEP (lOO ) i DCPUDX UOO ) • 

2 F(10O)*AVG(iOO) 

3 iCPK(iOO) .OcPKClOO) 

Equivalence . (Ocpqu«,dcpK) 

DATA PI/3.1A159/ 

DATA KSEP/3HSEP/ 

• A* ■ 

NSLOC =0 
N2 ■ Nl*l 

nT m NI«N1*1 

C 

C locate ENTRIES IN CHANNEL AND COnV£CTEO PROP; TABELS 
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1 LT « LTO 

2 IF (l.T,tiT,LTE) CAU ERHORi 

ir (chu,tj ;eq,chmJ>a 8) eo to 3 

LT s LT*UTNBXT JUT) 
qO TO 2 
C 

3 IF (LHE.EQ', (LMO-l) ) GO TO l2 

4 LH e LHO 

5 IF (LHpGT.UHg) GO TQ U 

IF JCH(UHJ;EQ,CHNSA8) CiO TO 10 
LH s LH*UHHEXT JLH) 

GO TO 5 
C 

10 macho * crgjlh) 

GO TO 13 

12 macho * macha 

13 TTo » TTTJLT) 

PTO PTT(LT) 

Gam • i,/QGaM(UT> 

RG * CRSJLT) 

!F< MACHO, gCJ^BITS ) HACHOsMiCHtNtf 
IF{ macho. BO.’O, ) MACH0»MaCH(n2) 

Machos* macho«macho 

180 GAMl « GAM/(GAM.l , ) 

CAp)(2 « 0, 

IF(CAPXi;Ng,fl, ) CAPX2?CAPX1 
CVP * RG/JGAM-l, ) 

TSo « TY0/(1,*V^>»<GAM-1, )«MACH0 a«2) 

PSO » PTO»<TSO/7TO)*»GAm^ 

VMAX « SQRT{2,»eAMl*RG»TTO) 

PToQPO* (li*{GAM«i, )*,^*MACh0«MaCH 0)*«6AM1 
CPT e ,5»0 aM«MACH0*MACH0 
DO 190 UNliNl 
MACHSQ<J JfMACHJl MMACHU ) 

PQPTJ I)f tCPJ I)«CPT*1, )/PT0OP0 
pwjn « PTO«U,«<Ve< I )/VMAX)**2 )»»QAm 1 
190 CONTiNUfc 

• calculate exp 

RHOT « PT0/(RG*TT0)«CG 

GAMM M 1,*(GAM.J, )*,J>»MACH0*MACH0 

RHOS * BH0TtGAMt«(*(l,/(GAM*l, ) ) » 

TSQ 8 TTO/GAMM 
V ■ MACH0»SQRT JGAM«RG»TS0) 

AMU « MUREF*(TSO/TRbr )«»1,5»(TREF*SCOM>/{TSO*SCON) 
AU « (S»(Nn’5W(Nl))/2, 

RE 8 RHOSfV«AU/AHU 
EXP 8 i;-g5 
IFJRE,QT72;E7) EXP8A,2 
IF(EXP,E0,i,25) GO TO 205 
CONI • ,23 
COM2 * ;082 
COn3 8 ,028 
COM4 8 •Ui/6.) 

GO TO 210 
205 CONI * .37 
CON2 » V036 
C0N3 8 ,'046 
C0N4 8 *,2 

210 IF(,NQT,AXI) EXP»0, 
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DO 2i5 IsNiiNl 
RtxP(I)»0i 

IP( .NOT; AXl ) RfcXP(l)#t, 

ir(RW<I),GT,0.) 8tXP< l)»RW< p««EXP 

PR(1) ■ <MACH( n/U,*MACHSQC I )*‘,2> )»*4**6XPM ) 

215 continue 

•B* calculate SW,CAPX,8fcX 
GAM12 ■ {GAM,i,)»,5 

AMU ■ MUREF*(TTp/TREF»A«l,5»(TR5r*SCON)/(TTO*SCON) 
Z2 » SQRT(GAM/((GAM«1, )»CVP*TT0) ) 
gamp • (GAM«2,)/<GAM«>1,) 

Z4a s SCON/TTO 

Z4d ■ t;/(l,*Z4A) 

ZIM « pto*cg/amu 

CAPX(Nl)fCAPX2 

call SETMUi IBLANK, ISEPfloO) 

DO 220 N«Ng|N.I 

1 « N»1 

SMD • SW(N)oSWn) 

AInT ■ ePR<N)*P8( I ) )»,9«SWD 
CAPX(N)= A|NT/PRtN)*CAPX( I )»PR(I >/PR(N) 

TTOT « l,*GAMl2#MA6HSa(N) 

Z1 « MACH(N)»Z1M 

23 ■ TTOT^.GaMP 

Z4 • a;/TT0T^Z4A)«Z4D 

REx<N)«Z2«ZlfZ3»24 
220 continue 

call LSPriT(SW(Np,0W(Nl),NT, SWI Nl>,P3(Nl)i*NT,l> 


TTqT • l.*GAM12*MACHSQlNl) 

Z1 ■ MACH(Nl)fZlM 

Z3 « TToTt«GAMP 

Z4 « (i;/TT0TtZ4A)«Z4D 

REX(N1)»Z2«Z1*Z3#Z4 


•c« Calculate theta,ostar, delta 

K2 ■ 0 

call SETMtj,o, /, ioO) 

THETA(N1}*0, 

PSTARINI «e, 

DElTA(N1J«0, 

P(Ni) • 0, 

PMAX * ■10,#»6 
DO 230 lANliNl 
IFU.NE.NlJ GO Tg 225 
1 F(CAPx 27EQ,0, ) GO TO 230 
225 CApxX « CAPXtI)*(REx(UfCAPx(n)»#CON4 

theta ( I >*CON 2«( a,*HACH90( I ) • , 1 7 ) IpgAPXX 
DSTARII )*CON3*a;*MACHSQI l ,44>*CAPXX 

OElTAII )AC0N1*CARXX 
IP( I lEQiNl) GO TO 230 
• CHECK FOR Separation 

tP( PW<l*l),LF,Plil(|) ,OR, I.LE;K2 ) GO TO 2290 
K A 1 

1229 K > K*t 

IF( K,6T-N| I GO TO 1228 
ir< pwtKj ;fiT;'PM(K-i) ) go to i225 
1226 K1 > I 

Kl.EO.IK.i) I GO TO 229 q 
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226 

227 


228 


229 

2290 


C 


230 


K 2 » K «1 


KIM * Klvl 

ir< mach{k 1M) ,Eo;o, > k1m=ki 

MACHOS* MACHSO(Kt) 


CPK(KIM)« 1 , 

DO 226 K»KIM,K 2 


fFt MACHfK) ,g 0 , 0 , ) GO TO 226 
CPK(K)»J.V«MACHSQiK) /MACHOS 


continue 

DO 227 K«KI#K2 

DCpK(K)s(CPKtK)-CPK<K*D )/(SW(K)-SW(K = l» ) 

K2M * K2*l 
DO 228 K«K1#K2M 

DCPK(K»s(DCPK(K)*UCRK(K*1) )«,5 

DO 229 K*K1,K2 

SWK ■ SW(K).SWn )tCAPXU ) 

F(K) • CPK(K)«(S0RT( AHS(SWk«OCPK(KM )»UlE«6)*REX(K)*8WK)««( 

continue 

FMAX « AMAXi(F( 1 > iFMAX ) 

IF( FMAXVUT, .5 ) GQ TQ 230 

SEPARATION 

ISEP(I>* KSEp 

1F( NSUOC.EQ.'O ) NSLOCsI 

continue 

N3 « I 


■ , i ) ) 


•D* calculate p for too 

234 P(Nl) * 0 . 

QO 240 UN 2 |N 3 
K « I-l 

AL * (R«(K)*HW{ U )*,5 

A 2 « (DSTaR(K)*DSTARU ) )«,5 

IF(AXI) 60 To 235 

P< 1 ) « A 2 »(PW( I )-PW(KM*P(k) 

GO TO 240 

233 P(D « 2 .oPi»Al%A 2 «(PW(I )«pM(K) )*p(K) 

240 continue 


« calculate TOD, TOTAL SKIN FRIcTIOn DRAG 
IF(AXI) go To 250 

DRM • GAM»{ (PW{N 1 )*MA 6 HS 0 (NI )*THETA<NI ) )-»<PW(N 1 >*HACHSQ(N 1 » 
1 •theta(n;))) 

GO TO 235 

250 DRM » GAM*{(PWtNI)»MAC'HSQ(Nl)*THETA(Nnif 2 #«Pl«RH<Nl))- 
1 (PW(Nl) 4 MACHSQ<Nl)»THETA(Nl>* 2 >Pt*RW<Nl) ) ) 

255 Tod « dRm-p(ni ) 

*E* calculate CF 
300 DO 310 1 *N 1 ,N 3 
RX.l, 

1 F(AxI)RX*RW(I> 

FKI) « RX»PW( 1 )*MAGHSQU ) 

F 2 ( I ) « FH I )«THETA( I ) 

REX( I)«REX( I )»(SUn )"SH(Nl) } 

310 continue 

NN » N 3 »N 1*1 

call LSPFIT(SW(NI) ,F2(NI) ,Nn,SW(NI)iCF(N1J ,NN,1) 


NXlsNl 

IF(MaCH(N 1 ) ,NE, 0 ',“) GO TO 319 
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NU"N2 
Cr(N2)» 0. 

319 DO 320 UnU,M3 

Crtl) • 2.»CF(l)/FlU)«2,»DSTAR(n*F3(l)/(GAH»PWn)§MA(;HS0(l)} 

320 continue 

CAtU UESTSQ(SWiDSTAR.NlfNl«3*S(DSTR) 

NN ■ N1 
DO 327 l.NliNI 

327 DST«<n» D8TR( I HDSTaRI 1 1 

CAU LSPFrT(SW(Ni>,DSTRlNl>,MN|SW<Nl),DP8rR(Nl),NNi4) 

• Write outpot 

WRITE < 641802 ) 

1002 rORHAT<//3?X,30H BOUNDARY LAVE R//> 

WRtTE <6,1804) ( I • XM < U t THET A( I ) » 0STAR( M %DELTA< II » REXU ) , 

1 CAPX(I),Cf (n45Hn),0STR<I),DDSTRei7,lSEPlI),F(l),I»Nl,N3) 

10 04 rORMAT(4X,lHI,5X,2HXW*4X,5HTHeTA,5Xi5HD8TAR;4X|5H0ei.TA,5X,3WREX, 

• 7Xi4HCApX|6X,2HCri8Xi2HSW*6X,4HDSTRi4x;5M0DSTRf5Xi3HSEP|8X; 

# 4HFSEP/ 

* (2XiI3ir9i4,3r9;5,F9,0fF9,4»F9;5,F10.4#2F9^5,2x»A6,Fl3,6), ) 

write <6,1803) TOO 

1003 rORMAT</6X|20HTOTAU FRICTION DRAGiiFl4;j) 

900 RETURN 
END 
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Cio n aan on on 


»DE.C!^ WRIA . _ . .... ... .. . .. 

subroutine UR I a 

• WRIA-- WRITE THE KET(5?) = A sTcI DAT.A .RiCbRD *WR]A«t 


C CHDATA. cONVTR 

c channel Input data table 


c 


index- LH=LH0.LHE 

Table of convected properties 
index- LT=LT0,irE 
CH s CHANNELNAME 

LTnEXTs index increment To the next cHaMMPL 
LPSi = relative location or PSt LIST 
NPT = NO. or PSli TTt Pr AND RCu VaLuEs 

ltt s relative location Of tt list 


LPT = .RELAX I VE .location Or pT.LIsr. . 

LRCU s RELATIVE LOCATION Op RCU LIST 

COMMON /CHDATa/ CHNaM(I) , lHN^ X T ( 1 ) ,’ W TEI ’OW ( i f .'t TO ( 1 ) ,PT0(1) , 

1 TS0<1. ),PS0(i) .MaOHOI i)V Anil vary Cl) , 

2 RG(1 ) ,GAH(1 ) . NRa)iNC(l)'jTABf6); 


4 88(75) 

L0G.lC.AL VARY 

integer chuam 


dimension 

real 

equivalence 

dimension 


vo(i) 

MACHO 

(V0»!tACH0) 

GH( i ) 4 LTNeXT( l)','N?f (i )'.'lpST (1) .’lTT ( 1 ) iLPt ( 1 ) .' 


1 . 

S> 


LRCU(l)f 

CRG ( 1 ) *CPG J ( 1 ■) , C2CP ( 1 ) 7QG am ( i i .>RT ( 1 ) ,FGP ( 1 ) , 


6 

integer oh 


FGR(l) »AREAT8(48‘>) 


d 

6 

a 


dimension XCh(1) 
equivalence (CH/XCH) 


equivalence ‘chnam.ch.^ . U.HNE.xT;i;Tij£XT rjiinr.LO.w^NP^^ 

< TTn.’l.PSi ) . <PTo»lTT> . (TSOVi’PT) . (PS0*LRCU) , 
(MACHO.CRG ) . ( AOiOPaj ) .’l VARv,’C2CP) 

(RG.QGAM) , (0,aM,FrT>7(Nr7fgP) .'(NC.FGR) . 

( TAB7aREAT8) 


dimension TAULES(I) 
equivalence ( CHMaM, TABLES) 


common /bcOMmN/ PR0gm(9> ,fIlIN,eIlOT 
logical FILIN, FIlOT 

common /ADAMdl/ NAME(6)*ADDREs(6).'TltLF<<S>7lDENT(6) 
COMMON /ALLCOM/ MA CHA , PS A , T s A . Pj A ,'t T a 7 A X T A ; RG A , G AM A 
4. . - MACH(;,psc.Tsc;p.tc,;TT(y;^A.xx.c;R,G.c;.GAMc^ 

K DAXIT ,SCALEA,‘'TTE;CHOfsf 

logical AXiVaXI a,a>^ic.chotst 

Real macha< D ,macHc 

common /BENDIN/ N3CIN<2),aCf(2) 
common /CR / 8(300) 

common /chits / BITS.IBLANK _ 

COMMON /CCRX 7'CRX'c6) ' ■ - - - 

common /cgrav / cg 

COMMON /CIADIN/ RHOBaS^RHOAmP.IaD'I 

common /CJNNeR/ INRcTR,RDUM.NlNNER(l6)VGNi)F(l6) 

COMMON /CISBOT/ FARELD ( 2 ) . ErEF ( 2 ) .'pRFS ( 2 ) i'PSP 1 SV ,’NZP , 

<4. ... ... ZPlit>J»J’Sp?lO),.MZ3i .. . 

integer FARFLD,FREE';prEs, PSPISV 

COMMON /CLlNgS/ L I NES , OM I TFk . PT i Tl'f ( 6 ) 
logical UMItP’K 

COmMO.N / JHSiJOQ.) _ . 

COMMON /c’maXa / ES2MX, ZMX, RmX; OSZMXV i'OUM¥ 
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common /CMaXIT/ MAXRKriNREriN.'GRFriMVTi' 

LOGICAL gReTIN. 

EQU1'/aL(;MCE. (MAJCTR/yRtriN^ 

COMMON / CNORM / RHL f RM* A hL . ArM 
COMMON ,/CPRlNT/ PDUmiX 3 ) . PRE F 1 N,'P REFN27Pni)M f 1 1 ) 
common /CPRPRN/ PRPRN 
im^ege^ PRPRN 

common /cPTMOV/ VelPOT, Icon'.’NOOENSVCPTnUM 
logical . . ... VELPQT .. 

COMMON /CR X RF(300> 

common /cretin/ DREFIN.SG21 .'vmGI. VMGR. NGfe , NGZ . SGR < 10 > .GR(ln) . 
li SGZ{ lO ) »G^ ( t o ) 

COMMON /CSl / SK 300 ) 

common /CS2 / S2(30G) ^ 

COmMOn /C-‘’S_, / ^SFitL,SS£E,S3pANG;SSoir"S«;|ffgQ,^SSFNj01i 

A DS"S( 2 ) I RHoW'.’RHOvi?sVTRicrRMnC» rhocss 

integer ssfml 

logical 0SEF» SSflF 

common /CTE / TOLWF* TGlL'FU, tEXI'2; tUF^ TErWF. JRET 
COMMON /CTOLRL/ TOLRL . MAXsWP .'cLEN .'dTOLRIVtOl'ES?* NSRP • 

^ - _ OiilOMPi.OSinpj. ,DT0LR2M) .R^iRFF.TOLlNR 

COMMON /cfMICK/ NTHKX,NTHkY;thKx< 25)VTWKYf'2'3) .fHIK2D(250» 
common /CVM / VMF^300) 

COMMON /C7 / ZF(300) 

common /iXORjg/ LhO.’LHE* LBoG.'LnDE'; tp; lWO.'UWe, LfO.'LfE. 

A LO.LESTA,LOo,LSE.LnUH(ft> . 

a __ MO.NM, NJ.NrCOLS.' MAyNj.^MixOl. ,MAXNM;MAXLE7 

A LEO’,'lEE» lRoVlRE.'lRD 

DIMENSION L1MITS{24) 

equivalence (LIMI TS;'LhO) 

common /SLTaR / W<128)ftX2n.2R)|SLCHNa?6> 

INTfgeR slchn 

O0.MMON yCAfi. ./ AOSV, .. „ ^ 

COMMON ^CPl / PI .TWqPI . plQ2,PtO4,TnDES.T0RAn 
COMMON /CHNFpT/ I CHN { 10 ) , wTfS ( lO > ,'wTF A (1 0 j /^JP t 0 ( 10 ) VWTT 0 UO W 1 
COmMOn /T'aPES / n''’aPG,n'''aPN 

common /BLBGY / 8L8I60) _ . 

dimension IQLB<60) 

EOUIVaLENcE JIBLBiBLbJ ...... 

COMMON /VTSCOS/ TREF , MUREF , SCON 
real MUREF 

LOGICAL STCFIL ... .... 

DAfA STCFIL/T/ 

OATA_K.Ay 4 .ilAZ . -. ... - — . 

aTldS2» CLE-'I*T0iLeS2 

IF(ES2MX;gT; ATLDS 2) WRlTE(6;i00i) 

1001 format (//////60H #»* The solution has_ not ct^NVERGED To The, input 
A tolerance". ) 

IF(GreFIN) WRITEi_6,i002) _ _ _ _ _ 

1002 format (/7//>/65H ««» THE INPUT GRlO RGFTM|?MeNT CRITElTiA HaVE n'Ot 

. . A BEEN, satisfied;.} ... ..... 

OMlTjFKr '.TRUE. _ _ 

IFthLOT} OMITFKs.FaLSE. 

CALJL _FHiAPlA4i _ _ _ 

TSC * TSA 

TTC _* TSC«( lj*tGAMA-l. )»i.5.»MACHA*«2) 

PTC s PS'g«(TTC/TSC)«*<KGaMa/(GAMA- 1; ) j 

_ 5J W R 1 T E ( 6 i_l 0 0 0 i A X I- , M AC H A ; R G A 7 T S C V G AM. A 7 P S A7iT_B 7 P_T C7 CH 0 TST7T tc7CG [ 

S NUGINi'ACF 
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moo Format (/15H general lMPUT-/6X»7HAyI *Vl'8;2_6Xi7HhACHQ s.’Fflm/ 
&6X.7MRG =,'f8.2,26X.7HTsO s,'F 3.2/ ftX77NnAH * iF874,’26X'; 

<t7HPS^O “if® ^3/ 6 X. 7 HTTE = .> 8 ' 3 ,'26y '.'7Hpfo_ “i'F ’8 i 3/_6X_, ^HrHQTGTs 

« i'L 8 .? 6 Xi 7HTfO sVFS . 2/6XV7hCG sFfi’ s7757H' STREAMlTNE E^D CONfi rT 

^ I0NS-/6X , 7 MNBCIN =i 2 l 8 / 6 X» 7 HaCF = 2 Fft’.T 5 //j . 

wRiT(= ( 6 ';ipo 5 J ssfml,sseanG';ssef,ssof 

1005 F0RMATU3H' curvature" CALCULATION FOR SURFRSONIC FLOW-/ 

&6X;7HSSFML =j^l8,'i9H (FOrMuLA NIHrER)/ _ _ „ „ 

&6X,7hBGEaMG?,FS. 3,'43H (iWLEt FLOW aNrLE.' DEgREE^i 8 SEF»T ONLYI/ 

6i/3RH SUBSn^ilC/SUPERSONlC BRANCH SELECTION-/ 

S6X.7HSSEF =,L8,'37H (SUPERSONIC FNTERlNf^i FLOW, T OR F » / 
&8XV7HSSDF =VL8,'56L’ (SUPFRSoNIC FLOW DnW.NSTREAM OF CHOKE RTaTion 

a, T OR F n 

write' ('bVlOio) '<GR( f),l=i;NG9) — - • — 

WRITF (6;i011> (SGR( 1 ) , Isi,NGR) 

IF(NGZ.EaiO) GO TO 65 

write ( 6 , 71012 ) f 62( I) , I=1 ,NgZ) 

write (6Vl0i3) (SGZ ( 1 ) , lai.MGZ) 

65 write (6”1014) VMG17vMG2,cRX 

1010 F0RHAT(/iXi9HGRlD SIZE CR I TfR f A-/6X7HN'r;R/ ftRalCFB . 2 ) 

1011 format (6X,7HSGR =,ioF8.2) 

1012 format (/ 6 X, 7HNGZ/G2=»10F8.2) 

1013 EORMaT (6X';7HSGZ =,10F8.2> 

1014 r0RMAT(/6X.7HVM01 = , F6 , 2 . 25V , 7wVNr.2 s.'FS 2//6X . 7HGRX s.ftFa’.S) 

wR'iTE"'{67I63o) nh.maxnm; lTst A 7MAxi’E'7“ n j7m axn j " 

1030 F0RMAT{ /IXIRH'^EMORY UTILIZATlON;/24Xl7nURFn AV A 1 L ABLE /6X11H3R I 0 
» POlMTSlii , Iio,'/ 6 X 6 HTABLEsIi 6 . I iO .V 6 X 1 i HSTRE AMLl NES 1 11 , I 1 q ) 

ATLDS2i CLEN*T0LES2 

WR iTe( 6 i 10 < 0 ) MaXREF,iNREFlH;I NRcTR 7T0L iNR'jtoi'ESg, TOLWFi, 

' ' CLEn7aTLUS2.eS2MX»‘ 

4 _ DSIDmP.DSIDPI.nODEnSiRHoC.rHoW.RHOCSSiRHOWSS 

1040 format (7i8H CONVERGENCE dAtA-/ 

&6X'i7HMAXREF3, I8,3X.21H{MAxIMUM REF I NFMPNTR ) ^ 

&6X7/HNRETrN=;i8724H - NUMBER OF REFINEMENTS/ 

6 6 )<ZHi_n_rctr=jlIo . 4 2 H - nlmbep Of iterations ir) la st Refinem ent/ / 

« 6 X, 7HTaLiNR=7"E8'.i747H ' < TnnER ITERAffofj TOLERANCE ON sIl7 MOVEM 

<SEHi)/_6Xi7,HT0lE32=i E6.1»37H., (FI.NaL TOl-EgAMCE ON S .L; . MJvEMEMt Y 

6/6X,7hT0lWF *. La.i;3X*40H<T.El CLOSURp FRA&TiONAL FLQW ToLfRANCE 
&)/ 

& 6 Xi 7 HCLEN a,0PF8.3.52H - cHARACTFRIsfrc LENGTH BASED ON GrID Sl7 
If cMJERIA/, E21,1753H AbSoLUTe TplfRaNCP aN S .L. MOVE MENT (tTO 
«LES 2 «CLENi/ 

66X;7HMaXeS 2=, Et'.l,42H ® LARGEST S'.L'. mOVfMENT ON LAST ITeRaTION/ 
S/6Xi7HDS1DMF = 70FF8'.3,54H (SJReAMWISE PT MOVEMENT DAMPING,' =0 FOR 

& NO DAMPING)/ 

&6X7HDSlDpl“»F8.3,53H UdDiTIOnAL STRFAmwIsP DAMPInS ON FIrST PAR 

OI^-Y)/_ _ __ _ 

S6X7HN0DENS'=',r8',‘58H (REFiNEMENf 'l'eVfL fh WhIcH CONST'ANT OEnSTTY T 

iS aSSUMBdU . - ... 

&6X,7mRHOc =,F8.3,1CH RrOw =',F7‘3.lriH RHOCSSa , F7 , 3, 

&10H RH0>'SS3F7;3,34H (CORRECTION EQ’. nfCEU? FACTQRS)) 

LINE.S a 64 

. . . CALL FHEADlUl — 

WRITE (6jl090) FARFl'D 

WRITF_ (6,’i 092) I ADM'/RHOBASf RHOAMP.'tOLRi' _ _ _ 

1090 format {/26H SPECIAL BOUNDARY OPTIONS-/ 6 x'.>HF ARFLD = , 2 ( 2X7 Aa ) ) 

109? F0RHAT(/ 26 ^_MATBIX SOLUTION PARAMPTERS^/sX/JHIADM = . l8,3X770H(=7 
11, 0 , 1 .' FOR STREAMLINE, ALtERNAfiNG’7 aNO ORTHOGONAL LINE RELA><AtlON 
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2)/ 6y,7HRH0BAS=,T8,3,3X;33H<ACCeL = RATinN FACTeR, B AS^ J-E VgL ) / 
36X,7HRH0AMP^.r8'.3i3X,45H(ACcELERAT?0N FACrnR’.' AMPLITUDE OF V/ARlATl 
40M)/ 6XV7HT0LRL =_i E8 . 1 , 3 x , 30 rl< TOLFR ANCP RELATIVE .T0,MAXD.R2) ) 

C print highlight and MaX. body radii AND ARPAS 
AHL s RML 

IFIAXIa) AHLsPURHLttRHL 

AKM = RM 

IF(AXIA) I 

WRfTf (6VlC9i) RRL. AHL^RmVArh 

1091 FORMAT <//6X, 17WHIGHLIGHT R AD I llS =VF 8 3 4V l5HH ! GML I GHT ARE A s , 

» F8i3/6X. l7HMAXi BODY RADlUs=. fB'. 3i Ax/l^wMAX? BODY AREA*»Ffli3) 

WRl TE (6i 1093 ) ACSV 

1093 FORMAT (6X,17HMASS FLOW RaTiO s,'F8'.3) 

C print cMANiN'EL TarLE' OF CONTENTS 
call FHEaDI?) 
write (6.1060) 

LH . =.LB0 

flO IFfLH.GE.LHE} GO TO 96 
MQRFl = 4 

if(nr(lh) Ine'.q) morel=morel*2*nr(lh) 

CALL FH6AD(MorEU 
LH2 X LH*9 

write {6,’1070 ) CHNaM (LH > , ( Wt FLOW ( '.hX ) Vi’HX bl'h ,'l H2 > 

NCX X MC(LH) 

IF(NR(LH) ’.LE'.G) GO TO 95 

WRITE (6,1 080 ) ( TAS ( 1 ) 1 1 si.nCx ) 

call TALipRT(2H8x.Q8(LH)»NCV*']R(i.'H) VnCX) 

95 LH X LH + LMNEXT ( LH ) 

GO TO 80 

96 continue 

1060 F0RnaT(/1X26HC0NTENTS OF CHaNnEL TaBIE-) 

1070 F0RMAt(//6X7HCHN x2X . A6 , 5 x7 HW fF LO Wx Bi'p 4 .'/6X7HTtO * F8’. Z'^BX 

»7HPTo =F8'. 3.5X7HTSO =f 8 . 2 ,'5x 7HpSn sF 3 ;3 , /6X7HM ACHO 8FR’.4.5X7 
*HA 0 = E12'. 4, iX7HvARY =l3.'/6X7HRG c F8 2.’5X7HGAM xFsi 4.‘5 

10 30 F0RMAT(/6X7HnG/TAB = 2X. A6iiH,5x. A6.’iH.’5X. Aj(,.iH,5X.A5.lH.5X. Aa»iM'.* ) 

c LOOP Through channels to pRint plow Rater; pressures, and ^pmp 

RHoInFx PSA/(RGA*TSA) 

VINE ~ SORT ( G AM A «RG A» I S A ) *M AcW A 
WTnORM= RHOlNF»V INFftPl 
J2 s n 

IC = n 

100 J2 , J2+1 

JcnN ' X RLcHN(J2) - . . . - - 

105' IF( JCHN.NE’.SLCHN( J2a1) .OR, J2’,EQ‘.NJ) GO tO llO 
J2 s J2*l 
GO To 1.05 
110 IC » IC*1 

WTFA( 1C>=W( J2)/WTN0RM 

1F( PGA'.NE'.I'. ) WTFa( IC>=W( J2) 

ICHN( IC)=JCHN 

LT s lto 

115 1F( JCHN.E0;CH(LT n GO TO i2q 
LTP = LT*LTNEXT(LT) 

1F(LTP' GE.LIe) go To 12 0 
LT s LtP 

GO TO 115 

120 lTp X LT+LPSI (LT)*NPT(LT)-1 
WTfS( IC>=XCH(lTP)/WTNORM 
tr(' RGA'.NEii; ) WTFS( IC)=xCH(Lfp) 
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M Ptot ir )»PTC 

wtto(TcT»ttc 

1 r ("J c H N . g Q ? C M N A M } L H y r "gp" •fD'~T?4 — : 

LHP a LH»l'MNEXT<LH) 

I F ( LHP.GP'.LHE) g6 to 128 

LH 8 LHP ^ 

60 To 122 

124 !F(PTQ<Lh3 INB.BITS '.aND, pTp( lMT. Mptp; ) Wgf 6 ( T C^gftTp ( LH I 

IF(tTO(LH) .NB.ilTS .AND', Tto< lH) . ) Uf TO ( t Cj afTO( LH I 

128 iF( jeIlTIn'j) go To itOO _ ^ 

130 WR I TE < 6; li3fl ) ( I,CHN ( 1) f WT^S ( I > . WTF A ( I ) ( I ) . WTTQ ( I > i' 1 ■l'.' I C ) 

1130 format (/ 4 ^H channel FLOW RaTeS" PRESSURES, 4(30 TEMPERATUBEs;// 
» 16X.9HSPEBlFlEDfc5X?8HAOJuSTEOi7X.6HPT/PRn.TXv6f|TT/TSO / 

(<^XVA6.4»^13:4*)>) ^ ^ 


return 




write (NTAPNJ STCFIL.<LIMITs(I).Is1.24) 

WRiTf(NTaPI^)(.( lD6NTn):iPi .A) ;AXU7R6r:SAMA:MiicMA.PSA.TSA:PtA. tT 


3 N8ciN(lii'N8ClN^2);fACF<l)iACF(2); SSFML■;^i^SEFvSSEANQ.SSDF;SSFE^Jri,' 

a ^ C"- A I rs ^ 1. ^ C‘ A 9 \ 


A rmociRhqcss;rhi,*RMx 
» TREriMURgF.'seON?(BL6iI 



5 (ZP(I)Vlfi;28)y (TABLSSdl.’lBiVLEStA); tJMS(l) 


6 isl.NM 

7 
& 

& (DTOLR2I I i iliBl.lJ .SG1R8F. 


rX2(l)ni»l*Nj) 




& (C Ry( I )V!»irfi) ; RHQBASBRHOAMP.TADM.NTHKyrNTHKY'; 

« (TMKJ^(I)»Is|,300)VToLwF) 


NTaPO s NTAPN 
N TaPN « NITSAV 

return 

ENH 





OOOOOOClOO OOOCIOOO 


•DfeCK WRI8DY 

SUBROUTINE WRIBDV 

•WHISDY WRITE OUTPUT FOR EaCH BOUNDARY •WRIBDYR 


C 


COMBI 


STATA8, CHDATA, BUVTAB 

station tabue 
index*. U'LOiLESTA 

scHOKE, station CROKE INDICaTQR ( ADJwr,BRWS;WRlOUT) 


1 

1 

& 

& 


MCL i sharp corner INDICATOR (BUDTbS) 

MCI ■ EIBUO index of cOnTROl STREAMLINE | PTmOVE.FLOBAL) 

COMMON /CHDATA/ Xl ( 1 ) , LNEXT { 1 ) , MLB 1 1 > , HUB CU , PR I M 11) , 

TYPELBU),N^MeLB(i),ILBUJ,rLB(l),SlLB(l) 
TYPEU8U),NAMEUBa>iIUBtl},FUB(l)iSlUB(l) 
VM0 <i)|DWDV(1),X2ClU) VSL6Hf(i)»MCLa>i 
ANGTE{l)iPTTE(l)»PSTE<l),rGRTE(l)|RQTE(l) 


A 


ANQ6XP|l)iasQEXP(475) 


DIMENSION 

equivalence 

INTEGER 


CRVt,E«ll,ANGLE*l> 

(SCM0KE*0WDv),<CRVL 6.AN8T6), lANGUeiPTTE) 
PRlM.TyPELB.TYPEUB.SCHOKEtlT 






boundary table 

index* LBALBOOiLRDE 

lbnext* increment to next boundary 

LBZl ■ increment to the first boundary point 1*0 before COaLLATIO 
CHNAMEa CHANNEL WITH WHICH tHE BOjnOARY DATA IS ASSOCIATED 
UP « T OR F FOR UPPER OW LOWER BOUNDARY 


1 

2 


LEDEX * relative index of L.E, point WHBN lower and upper surface 
CONTOURS ARE connected 

BDNAME,LBA,LBB*NAME AND INDEX LIMITS OF SPECIFIC BOUNDARY 

data when boundaries are coallaTed 
dimension 8DTa)iLBNExT(l>»uBZl<l)»' 

CHNaME(I) ,UP< i),LEDEx(Di 

ZBT<1)|RBT<1).AnG8T(42> 

logical up 


integer BDT.CHNAME.BDNAME 

dimension BDNAMEU) iLBA(i) *LBB(1) 


G 


DIMENSION 

Integer 

equivalence 

1 

2 

3 


CHNAM<1I ,LMnExT(1) 

CHNAM 

IXU-BOTiCHNaM), (LNEXT, LBNEXT, LHNEXT), (MLB.'LBZi), 
(MUb.CHNAME), (pR|M#UP); ITYPELB.UEDEX), 
tNAMELBfZsT.BONAME), < I LB» RbT , LBA I i (FLB«ANQBT, 
LBB) 


COMMON /BCOMMN/ 

logical 

COMMON /ADAMOl/ 
COMMON /CEDUMP/ 
cOhmOn /allcOm/ 
A 
A 

real 

logical 

common /cb / 
common /CBITS / 
COMMON /CCUBE / 

common /ccurv / 

COMMON /CFB / 

A 

A 

integer 

logical 


PR0GM(9)|FlLlN»nLOT 

FIlINiFILOT 

NAMEI6)rADDRESlfl>»TlTLE<6), TDENTI6) 

IGODMP 

MACHA*P5a,TSa,PTa,TTa^ AXtA,’PGA,GAMAi 
MACHC^PSC,TSC,PTC,TTC^ AXTC»RQC|GAMCi 
DAX lTiSCALEAiTTEfCHOTST 

MACHAiMAChC 

Axi a, axic.chotst 

B(300) 

BITS, blank 

NBC(2)|CI(2),C2(2),TEND(2J 

CUrV( 300 ) 

L, MA,MHfPi.B,puB,Hr, C hoke ♦ su 9 SoN» nk,plbc,pubc, 
XchOkE* TaReA.VmBC, WRQST^WcAlC, 0 V< 8 »» 0 VP{ 8 ), 
USUMiVMLBSQ 
XCHQKE 
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CHOKe«SUBSON 



Co ^ ffc 


COMMON /CGRAV / CO 
COmMOn /CIDEX / M, JiMO»MU,ISTaG 
COMMON /CUINES/ UNES|QMITFk,PT1TUE<6) 
common /cm / JMSJ300) 

COMMON /CDS2 / MACHM(«i00) 

HgAL MACHM 

common / CNORM / HHUi HM, AHL , arm 
COMMON /CPHll / PHIl(3oO) 

common /CPI / PliTWOpl,plQ2,PiQ4,ToDEG.TORAO 
common /cprprn/ PHPRN 
INTEGE^^ P«PRn 

COMMON /CPSM / Pb'M(300> 
common /CS2 / PTM(300> 

COMMON /CR / RJ300) 

common /CSl / SK 300 I 

COMMON /CTHlCK/ NTHKX 
common /CRMS / nM( 300 » 

COMMON /CVM / VM(300) 

COmmOn -'cZ / Z<300> 

common /ERASgP/ XIl<lOO),SW(lOO),zw(lOO).RWaOO),ANGW<iOO), 

« CURVW( 100) • VE( 100) ,MACH{lt)0>iPSOPO( 100 ), CP (lOO), 

* PSQPT(100),PTQPTO(100), T T ( 1 00 ) » AW ( lOO ) , SPDA { 10 0 ) 

DIMENSION DSTR(IOO) jDOSTHdoO) 

EQUlVAL,fcNCE (DSTH, ANGW)*(DOSTRiCURVR) 

C NEW variables for NASA VERSION ONlY--pSQPT AND PTQPTO 

common /erases/ AUAN(100),CDRl(lO0)iPSMPOflO0)»LAMW(100) 

HEAL MACH 

dimension XW(l),YW(i) 

EqUIVAIENCE dWiZW) d yw.rw) 

common /CFRFlD/ FSAV(300>, STxU(l28),STXDfl2a).STYU(l2b),STYDll28) 
common /IXORIG/ UHO.LHE, LBDO.LBDS, lTO»LTE,’ lWO.URE, lfo.lfe, 

L0,LESTA,lS0,lSE»uDUM<6) , 

MO,NM, Nj.NfCOLS, HAXNJ.MAXOU.MAXNM.MAXLE, 

LfcO#UfcE» lWO.L»E»lRD 

COMMON /SLTAb / VU128)|X2(128)|SLCHN(128) 

integer SLCHN 

common /CHNFPT/ ICHN(10).WTFS(l0)iWTFA(10)»WPT0(l0)iWTTOtl0)i IC 
COMMON /BLBDY / BtB<60) 

dimension IBlB<60J 
EQuIVALtNCB (IBLBjBLB) 

COMMON /BLDTa / BN AME | LOWER , 1 BT YPc , Nl , N I ; GAPXl 
integer BNAME 

common /TETAB / ITE,XlT2(l6)iTEANG(16)iDSTTE(l6)iDDSTTttl6) 
ft RTfc(l6) i?TE<l6)iLWER(l6) 

logical LWER 

COMMON /SABCHN/ CHNSAB 
iNfEGE^ CHnSaB 


integer HLE.HTE, ASLiBDY,T5L»CHNN,cHN,XK5SV;XkEYB,BLANK 

LOGICAL DOUBLE, lower, UPPER 

dimension L0WUP12)VLCDPI (2) 

DATA L0WUP/5hl0WER,5HUPPER/ 

data HLE,HTE/2HLEi2HTE/, aSl , BDY, TSL/3HASL * 3HB0Y , 3HTSL/ 

ITE « 0 
IGOOMP* 2 
NTRY s 1 

C define RfcFERtNcE DYNaHIc PRESSURE, ETc 
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QO « 0, 

, IF(MACHA;lEi .1) GO TO 95 
IF(GamA|NE', 0,) 00 TO 9JJ 

00 * (RGA»TSA)/(PSA«(1ACNa»hACHA) 

GO TO 

92 00 » 2,/(GAMA«PSA«MACHa»MACHA) 

C BEGIN LOOP through CHANNELS 

95 UlN^S ■ 64 

1 UP * 4 
NCHN * 1 
J2 ■ 1 

105 CHNN X SLCHN(J2J 
lower s ,T«UE, 

I c 0 

1071 « 1 *1 

IF(CHNN,KlEi ICHN( n ,aND. IiL^.IO GO TO 107 
OPTO c l./WPTO(I) 

QTtO * 1 . /WTTO ( I ) 

GO TO 122 
110 J2 ■ J2*l 

1F(J2,E0,NJ .or, SlCHN( J2-»1 ) ,NE;CHNN) go to 120 
GO TO 110 

120 LOWER « '.FALSE, 

C build laSUBSCRlPTEU ARHAYS 

122 M s MBEGIN(J2) 

1 . * 0 
SPDASVi 0, 

XK9SV * BDY 

123 I • 1 
SWORG * S1(M} 

PTO * PTH(M) 

TTO • TTM(M) 

TTQTTO* TTM(M)»OTrO 

124 DOUBLE* .FALSE, 

125 CAUL GETIX 

call s'tano(m,l,ubpeb) 

XIlM )*Xl(L) 

SW(p s Si(m)«-SWoRg 
ZW< I ) • Z(M) 

RW( 1 ) X R(M) 

ANGWt nspHUlM)»TOD6G 
PS X PSMjM) 

IF (XKJSV.N^JSL) GO TO 126 

ISfGN • 1 

IF (LOWER} ISIGNR-1 

mysl • M*1^1GN 

IF ( (ABs(R(M)«R(MTSL)» iGTiI.E-S) , OR , ( ABS ( Z ( H ) -2 ( HTSL > ) 

& ,GT,1.E,5i) go TQ 126 

ANGW(I)x ,9*(PHI1(M)^PHI1 (MTSlM*T0DEG 

126 CURVW{ I >x CURV(M) 

MACH( I MACHM(M) 

VE( 1 

C T.E. singularity 

!F( ISTaQ:NB, 2 ,‘UR. <TYPELB(L);NE.KTE;AN6.TVPEUBa},Nt,KTE) ,3H’. 
* 0SQEXP(Ur,EO,8lTS) GO To l38 

lF(l,NE.liAND,BSOEXP<l.),GE,0,> 30 TO 132 
VB( I ) X B I 

!F(FQKTe<L) ,£Q,’0, ) GO To 132 
MACH( J )xSQRT{1','*BSQEXP(L> ) 
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TSX s TTM<M)/(l,*.5/F«RTfca)*(l,#0SQEXPtL7) ) 

VtU) • MACHn)«SQRT(tl,/FQRTEJi,)*i; )#R 6 Te(L)*TSX> 
PS • PTM(M)«(TSX/TTM»M) )n«(PGRTEa)*J, } 

C downstream SlDf ONLY 

132 irn»l) 134 i130»134 
134 ANGW<n»ANGTE{L»«TOUfeG 
GO TO 138 

c upstream side only 

136 ANGW< I J»ANGEXP(L)AT0UBG 
CURVW( DEBITS 
138 AW(I) m RW(1) 

PSQPTC 1 )*PS/PTM|M) 

PTQPT0( I )*PTM(M)#QPT0 

lf( AXIA J AW(1)APIaRW( 1 JttRwdJ 

PSQPOt I >4PS/PSA 

PSMPO( I )*PS«PSA 

CPti) • PSMPQtUtOO 

1F(L0WE«} PSMP0( l)s*PSMPQ( I ) 

NI » T 

1 ■ 

IF(NI,eQ;iJ GO TO 160 

c check for Leading edge point 
IF( ISTaG.NE,!) go to 140 

if(Typelb{L);eq;hl 6 ,or, typeub(L) .eq.hlbj go to i7o 

C ISTAGil 

IFIDOUBLEJ GO TO 160 
double* ,TRUi, 

GO TO 125 

C CHECK FOR TRAILING EUG 6 POiNT 

140 1F<ISTAG,NE,2) GO TQ 160 
C ISTAG42 

!F(TYPEL9tL> iEQ.MTE .OR, TYpEuB(U .EQ.HTE J GO TO t^O 

c istag*o,'3 or oouble*t 

160 M • MD 

tF(M.GT,0) GO TO 124 
GO TO 180 

C APPROACH streamline 

170 XKEYB iASL 
GO TO 200 
C BODY SURFACI 
180 XKEYB ■ 4XK3SV 
GO TO 200 

C TRAILING streamline 

190 XKEYB *XK5SV 
XK 9 SV A TSL 

200 IF(XKEV0 , 8 Q,TSL) GO TQ ZjO 
IF< .NOTiLOBER) G0 TQ 220 
L8 I L'BP{NaMEU8<U) 

IF(LEDEXfLB)?EQ,0) GO T9 220 
C LOOP TO find boundary NAME Of UPPEP SIDE OF L.Ei 

lbx * lb 

214 lF(LBA<LBX),QE,LiOEX(L@n Gq TO 220 
lbx » L0**3 

lF<L 8 X,LT;aB*LBZl(LBn ) GO To 214 
call ERRORf 
C PROJSCTEO area 
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220 call SETHUti.i UAMH.Np 
DATA LCDP1 /A«CDPIiiAHLAHN/ 

LlCDPlf tCDPT.(2j 
ir(NTHKX7LSa) 60 TO 28<| 

CAUL uriTZPfZWiRMiLAMWiNI) 

DO 222 U2iNJl 

COEP * ^5t<UAMWM)%LAH«(l»t>) 

IF(AXIa) CDEr*Plf (RHU)«LAMWM)AR><(Ul)«UHll(t»l)) 

222 AW(P » AMII«UA60Ee«(8N(]).Rw((«|)) 

C PRESSURE DRAG 

224 SPDA(1 )pSPDASV 

CAUL LSURCRW.PSRRO.NIi SPDA) 

SPDASVs SPOAfNM 
C D«A« cOEPFlc^iNT 
ARM * RM 

IF ( AKU I arm R PpRMfRM 

DO 225 lAtfNf 

AM(1) • (ARM«AMIt))/ARM 

225 CPPt(l) > «SSDA( l)*QO/ARM 
ADDQ r •SROaSV«QQ/ARM 
LLCDPli LCOPKII 

230 IF|PRPRN7EQ,|.2r;AND,XK8YB,NE.8DT) QO TO S09 
LINES ^ 64 

call FHEad(NI*6) 

308 KUP « 2 

IF(LOWER) KUP=1 
CHN ■ SuCHN(J21 

X(2 « X2( J2) 

SMQRG ■O'. 

CHNSAB ^ CRM 

WRiTe (6,1800) L0NUP(KUP),ChN,Xi2,lUCDPI; 

6 (xa(n;sR(i),zv(U,RwU)* 

• AN6W(n«'CUR9W(niPSQPOU}fCP(I),PSOPT(nvMACH(I).CDPI(n,Aw(l), 

• PTOPTOd JiUliNU 

1200 format (/2 X,A6 i1 FH BOUNBART TO CHM«,A6;8m. STREAMLINE COORDlNAT 
»E, XI2*,P7:3#1I4.// 5X»3HX 1 1 . 6 X, 3HSiW , 7X»5HXW , ZW*6X»5Hyw, Rh^SX, • 

« 4 HANGW, 5 Xi 5 RCUNYR, 5 X^|HPS/P 0 , 5 X, 2 HCP; 4 X;$HPS/PT, 4 X, 4 HMACW» 5 X, 

& A4,14H (AMA)(-A),(AMAX|8H PT/PTQ / ( 2Xf2F8*3.Fl2, 5, FU, 5, 

• Fe,3,Fli;ji2F9,3iF7,3i2F9,4,F14,3,F8;3,Tp) 


write (6;i2io) ttqtto 

1210 format (/ 6 X 18 HTTXTTO »|C9,3J 

IF ( X«EYb;EO,aSL ) WRITE (6,1220) ADO^ 

1220 format (/6Xil5HABOlTIVE ORAQ s,F9,4) 

IFe XKEYB.BQJASL ,OR, XKEyB.EO'TSU ) GO TB 309 

BoUNbARY layer 

name • NAMEuB(Ll 

IF( ,NOT;LOWBR J NAME??N6MEgB(U) 

LBL R LBOYBL(NAM£,UQWiR) 

|F( UBUiEOlO ) G0 TQ 3Qf 
CApXi 9 6LB(LBL«2) 


0NAME 9 IBLBIUBLI 
tSAVE 9 LEBTa 


CAUL SABINTRV) 
ldte , lesta-lsave 
IF( MD.QTvP ) LRL^LDTE 
NTRY ■ a 


C9«««««*«*»o»«8«»«#»*9f*«*ft**ff»*««**«««»4««»9»|»6*»*P**4*************** 

IF(TVPeHU>i'EOiMTE ,OR,- TYP 6 UB(U IIQIHTe j ANGSV«ANCW(Nn«ToRAD 
309 lF{TVPBLllb)}E0i8TE ,OR, TYpBuBfL) .E oShTEJ QO TO 30Q0 
GO TO 3091 
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3090 ITE j TTIJJ 
XjT 2 <ITeJ# XJ 2 
TEANG(ITi)|ANQSV 

QO TO 


3091 


«TE(IT 6 )i RWJNU 
2TE(lTB)i ZW|NI| 
LWEHMTEJ* U 0 W 8 R 
DSTTEdTiJi DSTRfNU 
DDSTTE< lTE|»ODST«(Nl) 
3091 1F<MD,QT70J go TO 183 


c integral momentum balance on The channel 

!F<,N0T, L9M8R) QO TO 310 
PFlB p SPDASV 
QO TO lie 

310 PFUg p SPDASV 

pToT * S'^*'J?j2)4PFcBAPfUB 
P6RR P rTOT,STXg(J8) 

write <6a3O0» CMN,STXU»J2),PFLB»PrOB#TToT,STXD< J2)iFBRR 
1300 P0 RMaT(/ 1X92MINT86RAI MOMENTUM BALANCE. eHNsA6|2K19H(AXlAL FORCES 
• QNLY)/6X3tH8NTERlNQ MQHENTuM «Pll , 4| /6)|31 Hl0WER BOqND 

•ARY PRESSURE FORCE ^Fll , 4, /6X31HUPPER BOUNDRRX PR|$SURE FORCE >rii 
•.4,/i2XiaWSUM or A0qVEf|4,4,/6X3lHLSAVIN6 MOMENTUM .F 

•U,4,/12X2SHBRR0B pFllil.T 

U 2 « U 2 *l 
|F(J2,LE?NU) go to t05 
C SAVE TE data 

CREBUILO wake table AT ALL Tg9 ~ 

call rbwake 

IF( NTRY?E0,2 ) CALL SR8(3> 

return 

END 
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O ClOO o 


•DECK WRIOUT 

SUBROUTibiE WRIOUT 

•HRIOUT WRITE STC OUTPUT DaTA fWRJOUTR 


STATION TABliE 

index- i*lo.lesta 

SCR0KE> STATION CHOKE 1»0]CaToR < A0JWP«8BMS»^WRI0UT) 

HCL ■ SHARP CORNER INDICATOR (Bi,DTBS) 

HCL A rieUD INDEX or control streamline (PTM0VE«FL0BAL) 

COMMON /CHOATA/ Xm)iLNExT(l),ML9(l>*MWBei7*PRINVlIi 


I 

1 

A 

& 

A 


OIMENSTON 

equivalence 

INTEGER 


DIMENSION IPR1M(U 

equivalence URRIM,PRIM> 


TYPELSm .NaMELBU) I ILBUI.rUBti) iSlLBU) I 
TYP6U8UI ,N4MBU8( IJ , lUBUi ,TU8(1) *SiUB<U . 
VMea),OWOVa),X 2 CL(U. 8 LSWMt)»HSLU)| 
ANGTE(iI,PTTEa>,PSTEa);F 6 RTEU)iRQTBU>. 
ANG6XP(1|,8SQEXP(4?9> 

CRVLE(1I*aNqLE(U 

{SCHOKi,OwOV),ICRVLB,AN®TB),'{ANQUS,PTTE) 

PHlM.TJfPELB.TYPEUB.SCHOKBeiT 


COMMON /BCOMMN/ 
LOGICAL 

common /ADAMOl/ 
COMMON /ALLCOM/ 


A 

A 


REAL 

logical 

COMMON /CBITS 

integer 

COMMON /CCURV 

common /cfb 


RR05M<9»,FlLlN»FlL0T 

FILINiFIlOT 

NAME(6)fAD0REs<6),TlTLEt6Ji JOENT(Q) 

MACHAiP5A,TSA,PTA,TTA, AX!A?RGA|6AMA» 

MACHCiP8C|TsC,PTC,TTCi AXTC,'RQCi GAMS* 

DAXiTiSBALEA,TTE,CH 07 ST 

MACHAiMACHC 

AXIAiAXICiChOTST 

BITS, BLANK 


BLANK 


A 

A 


integer 

logical 

common /CQRAv / 
COMMON /CIOEx / 
COMMON /CLINgS/ 
COMMON /CDS2 / 
REAL 


CURVFI300) 

LiMA.M 6 fRLR|Pu 3 ,Wf ,CHOK 8 ;gUBSONi 
XCHQKEt TAREA.VMBCi WRQ9T»WCALC( 
JSUM,VMLBSQ 
XCHQKE 

CH0KS«6UBS0N 

CG 

Ml J|?MU|MO, ISTaG 
LINES|QMITFk,pTiTlE<6) 

MACHMI300) 

MACHM 


NK|PL8C*PU6Ci 
QV( 8) iQVP(8) I 


common /cpwii / 

COMMON /CPl / 
COMMON /CPRPRN/ 

integer 

COMMON /CPSM / 

common /CS 2 / 

COMMON /CR / 

cOhmon /css / 

A 

Integer 

logical 

common /crws / 

COMMON /CVM / 

common ^Z^ t 
common /SRASE2/ 

A 

A 

A 

HEAL 

dimension 


PHU(3Q0» 

PliTWOPI,PlO2,PlQ4,ToDEGi'T0RAD 

PRPRN 

PRPRN 

RSM<300) 

PTMI300) 

RF(S00| 

SSfmLiSSeFiSSeanGiSSdFVSSreND.SSFNOAi 

DSS(4)4TSIC,RhOCiRHOCSS 

SSFML 

SSEFi SSDF 

TTM<300> 

VMFI300J 
2^ (300) 

AREA(98l|AREAO(96),0lSpl9|),^PT(96)iLAHHDA(96)i 
RH0i96ltSQRTVV<96j;TS<96UTT(96|,VMS0(96)i 
WmOkPIVA) I 

HQA<96I#HSTA<96), RQ(96 ) ;c2CP( 96 ) »F6R( V6 I 

lambda 

BS2(96)»S0NQRm(96) 
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EOUIVAUENCE (bS2#VVKQKP), (SDN3RM.RH0) 

DIMENSION RCU(9<»» 

tOUlVALBNCe fRCU.bAMBDA) 

COMMON /ERaSE 3/ (10 ) tKl ( 1Q > , CHANLS(10 )«RS(96) i HACH< 96 ) « rLQW( 96 ) 
DIMENSION Xl2<96)fZ(96> ,R(96>»PH|t9|) »’CuRV(96IiPSQP0(96J • 

& VM( 96 > I CVX ( 96 ) »FVV{ 96 ) #rpj(( 96 >/FP¥{ 96) #SVX( 96 M 

& SVYi96) »SPX(96> «SPY<96) »STX(96) #STY(96> 

EQUlVALENCb iAREA0|Xl2irVXiSTX)i ( D|6 r . Z • TV Y i STY ) » 

& (SQRTVV,R,FpX), (YMSQ.PHItFPV), ( WKQKP, CURV, SVX ) , 

& (WQA,PS8P0*SVY). (C2CP,VM6SPX)i (FUQWfSPY) 

integer chants 

real MACH 

DIMENSION X(1),YU} 

equivalence (X,Z),(Y,R) 

c NEW variables For nasa version only 
C CAN USE FGR IF NEEDED 

dimension PFLOW(?6),PSOpT(96)iTSOTTe96),CP(?6)iAOAREF(96), 

» PTQPTO{96),FLOWMX(10) 

equivalence fFLQW,PFU0W), ( LAMBDA. PSORT ) . (TS.TSQTT), 

» (HHQ,CPJ , (FGRiAQAREF) , (BG.'PTQPTO) 

COMMON /IXORIG/ LHO/LHEf LBDO.LBDE, LTO.LTE; LWO.LWE, LFO.LFE, 

5 L0,L£STAiLS0iLSEiLDUM(6). 

6 Mo,NM, Nu.NpcoLs, maxnj;maxol , maxnm , maxle , 

& LbOi'LEb# lROiLRE.LRD 

common /CFRFlD/ FSaV(300), STxU( 128) ,STXD{128) ,STYU(128) »STYD( 12B) 
COMMON /SLTAB / W (128 ) | X2 ( 128 ) i SLCHN{ 1261 

integer SlCHN 

common /CHNFPT/ ]CHNa0),wTFS(lO),wTFA(10Ji«PTO.(10)»HTTOIl0)» IC 

INTEGER DBSTaR, SUB, SUPER, BRANCH.ASTERP.T g 
LOGICAL UPSTRMiONSTRM 

DATA TE/2HTE/ 

iSODMPa a 
PIINV « 1,/PI 
QO a 0. 

if(macha.lb,,'i> go to 

IMCAMAiNEiO,') GO TO 92 

00 » tRGAtTSA)/(PSA*MACHAaMACHA> 

GO TO 95 

92 00 s 2 ,/(GAMAfPSA»MACHA»MAcHA) 

c begin loop through stations 

95 choke • 7FALSE, 

IFlELDa 0 
jSUM « 0 
lines ■ 64 
LInEa 9 D 
L « LO 
500 PUB « 0. 

PUB • DV 
wF « o; 

c subsonic/supersonic BRANgH selection 

M ■ MLB(L> 
call GETIX 

JA « J 
MAA a M 
M ■ MUB(L) 

CALL GETIX 
J 8 a j 
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MBB • M 

1F( JSUM,BO;OJ SUBSONs,T«UE, 

!F(SSEn SUBSONs.’FAtSE, 

IF(SCHOKElUJ .NE'.XCHQKbj GO TO 5lO 
IF(SSDF> SUBS0N**VFALSE, 
jStlM » JA*236»JB 

c EXECUTE Flow balance 
510 call FLOBAU 

iF(TYPELBa) ;EQ|TE .oh, TyPEUB(L),EQ‘.TE» JSUMsO 

C BRANCH ANP aSTERP ARE PRINTOUT INDICATORS 

DATA DBSTAR/2H**/, SUB/3HSUb/, SUPER/5H8URER/, ICH0KE/5HCH0KE/ 
501 asterp* blank 

1F(PRIM(L>) aSTeRP=DBSTAR 

BRANCHc super 
IF(SUBSON) BRANCH=SUB 
iF(SCHOKElL);EQ;XCHOKE) BR ANCHp I CHqKE 

call SETMUiBLaNK, CHaNLS.Iq) 

CALL M0VE«2,ZF(MA) ,Z,NK,i, RF(Ha),R#NK, J) 

CALL M0VE18,CURVF(MA),CURV.NK,1. VMF ( MA I ; VM ,'NK , 1 > 

LU « 0 

K « 1 

H B HA 

520 FLOW(K)owSTA(K)»Cli 

PH1(K)« PHU(M)»T0D5G 
QGaM a FGR<K)/U,*FGR(K) ) 

MACH(K)sVMIK)BSQ8T(QGAH/(RG(K)aTS(K> ) ) 

AQAREF<K) a R(K) 

IF ( AXU J A0AR|F(K) P PI*R(K)*R<K> 

PS(K) « RH0(K>»RQ(K)*TS(K) 

PSQPO{K)«PS(K)/PSA 

PSQPT(K)*PS<K)/PT(K) 

TSQ7T { K )aTS( K )/TT ( k> 

C CP must FOLLOW USE QF RG 
CP(K)a (PS(K)-PSA)*00 
CALL GETlx 
XI2<K)« X2(J1 

1F(SlCHN{ J», eO,CHANLS(LQ) ) GO To 530 
LU a LQ*1 
JKLQ)* J 
Kl(LQ)f K 

CHaNLS<LQ JPSLCHN( g) 

If"(LO,GT;i) FL0WMX(LQ-1 )sFL0W(K> 

I * 0 

525 J • 1*1 

!F(SLcHNtJ),NE,IcHNlI),AND,l,LT;IC) GO TO 525 
QPTO a i./WPTO(I) 

530 PTOPTO(K)*PT(.K)«8PTO 
K a K*1 

H a M*1 

|F(K,LEiNK> go TO 520 
Jl(LQ«l)aJ*l 
Kl(LO*l)aK 

FLOWMX<LOJ?FlOW(K’-1)' 

LQS a 0 

533 lQS a LOS*l 

KB a K1<LqS) 

KE f Kl(LOS*l)"l 
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FLHX » 1./FL0WMX(L0S) 

QO 535 KsKB.KE 
335 PFLOW(K)*rc,Ow(K)#FLHX 
!F(l,0S,UT,l,0) GO TO 533 

Xll * XUU 

IF(PRPRN;E0, (^l) ) GO TQ 6l0 
LInEA * 4 

!F( JPRIM(l) iNE.O) LlNEAfS 
CAU. FHEad<L1NEa*NKT 

write <6;i 6O0) XU,ASTfeRP,CHANl.S,9RANCHi 

1 (Xl2<K).PPl,0W(KhZ(K)4R<K),PHl(K),CURV<Kl,PSQP0{K)|PSaPT{K)* 

2 TsoTT<K),CPCK>,MACH<K)»AQAREF<K)|PTqPT0(R»,'K«1»WK) 

1600 format (/29H STATION COORDINATE, X Ua^F? . Si A2, 13H CHANNELS- i 
110(A6,2XJ ,A5// 5Xii3H*l2 STrM FNCT, 6x;3NX,'Z# BXi 3Hy i Ri 9X , 3hPH I , 
16X,4HCURV,6X,21HPS/P0 PS/pT TS/TT,' 6X;8 HCPi 6X. 4HMACH, 6X, 

3 6H AREA.3X.6HPT/PT0 / < ,F6 , 3. FlO S,ri2 . 5 1 FU , 5# FV , 3, Pn , 5. 

4 F9,3i2F8.3iF10;3iF$,4,Fli,3,r9;3i7X, ). ) 


610 IF< IPRIMeu ,EQ,0| GO TO 8 q 0 
M a MA 

DO 620 K*1,Nk 
COSPH l* COS(PHIKM)) 

,S1NPHI« SlN(PHIllM)) 

FVX(K)aVM(K)»COSPHl 
rVY<K)»VMlKUSINRHI 
FPX<K)«(PS(K)-PSA)*60SPHl 
FPV<K)a(PS(K)-PSAUSlNPHl 
620 M a M*1 

SVXIDa 0, 

SVY<l)a 0, 

sPx(D« o; 

SPY(l)a O'. 

call LSPriT{WSTA,FVX,NKr WSTA.SVX.nK, , 1 ) 

call LSPnT«WSTA,FVY,NRa WSTA.SvY,NK, -1> 

Call lspfiti area,fpx,nk^ aRea,spx,nk, -i> 
call LSPF1T( AREA,FPY,NK» area, spy, nK, -tJ 
DO 630 R*1,NK 
STX<K)a SVX<K)+SPX(K) 

630 STY(K)a SVY ( K ) *SPY ( K ) 

KA « 1 

DO 640 LL*liLO 
J * JIILL*!)*! 

K a KULL*!)-! 

IF(MU,NE70) 60 TO 635 
STXU( J»=STX<K),STX(KA> 

STYU( J)*STY(K)fSTY(KA) 

635 IF(MD,NE;o) go to 640 
STyD( jjaSTYlKI’-STYIKA) 

STXD( JI=STX«K).STX(KaJ 
640 KA « K 

IF(PRPRN7EO,f-l>) GO TO 800 

write <671700) SVX(NK)|9VY<NK),SPX(NK),SPS'<NK),STX<NK)|STY(NK) 
LINES a LINES*4 

1700 FORMAT</6X25HSUM,VMaCOS(PHl )*DFLQW TF3 072;36X, 29HSUM»VMaS 1 N ( ?H I J 
••DFLOW aflo,2i/6X25H5UM-(p-pSO)aCOS<PHI J*DA sf 10 , 2i 36X, 25 hSU 4» ( P 
a-PSO)aSlN<PHl >»DA sFl 0 1 2 1 /6X25HTOT AXIAL MOMENTUM FlUX 3ri0‘.2|34X. 
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• 25HT0TAI. Y.MOMENTUM FlUX *FiO;2,> 


C REUOCaTE data INT0 THE M*ARRaYS 

800 CALU M0VEI2# MACH,MACHfHMA),MK,l, PS , PSH I MA 7 # NK ,1) 
CALI MOVEIB,PT.PTM(MA)aNK,1, TT , TTM ( MA ) *N(< . 1 ) 


C FILL IN STaSNaTION POINT VaUuES 
IF(MLB(L),iO;MA) GO TO 820 
M « MLBiL) 

CALU GETIX 
HACHM(M)*0: 

PTH(M)«PTMfMU) 

PSH(M)«PTM(M) 

TTM(M)«TTMIMU) 

VMF(M)* 0, 

820 IF<MUB<L GO TO 830 

H 9 MUB(L) 

CAU. GETIX 

MACHM(h)*0i 

PTR(M)»PTM(MU) 

PSm(M)«PTmIM) 

TTM{M)«TTMIMU) 

VMF(M)« o; 


C 


INDEX TO NEXT STATION 
830 L ■ L^lNEXTai 

IF (L.LTjLESTa) go TO 500 


return 

end 
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•DtCK STCXX 

0VEWLAY(STCi3i0) 
program sTcxx 

COMMON /CMAXIT/ MAXlTjMAJcTR.QREriNiEDUM 

common /Select/ l^ntry 

CO TO(10;iS#20)itENTRY 

10 call refine 

GO To 25 

15 call SLC 
call PTMOVi 
call spc 
call FARFLO 

GO TO 25 

20 call adjSl 

23 RETURN 
END 
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•DECK EHRORY 

SUBROUTINE ERRORl 

CEDUMPX EOUmP for STC execute section •kDUMPXP 


LOGICAL IPLOT 

common /CHDATA/ TABLESUI ,I-NExT{1),ML0{1)*MUB(97) 


COMMON /ALLCOM/ 
COMMON /CB / 
COMMON /CCURV / 
common /CDS2 / 
.COMMON /CEDUMP/ 
COMMON /CF8 / 
common /CIDEX / 

COMMON /CLINES/ 
LOGICAL 

common /CM / 
COMMON /CPHll / 
common /CPLOTl/ 
LOGICAL 


common 

/CR 

/ 

COMMON 

/CRMS 

/ 

COMMON 

/csi 

/ 

COMMON 

/CS2 

/ 

common 

/CTABpR/ 

common 

/CVM 

/ 

COMMON 

/cz 

/ 

COMMON 

/ERASE2/ 


& 

real 

dimension 

equivalence 

DIMENSION 
equivalence 
common /IXORIG/ 

& 

& 

& 

common /SLTAB / 
integer 

common /BLBDv / 

lP|.OT « PlOT 


MACHA(gO) 

B(300) 

CURV(300) 

DS2<300) 

IGODMP 

L»0FB(4) , IB.DFBK 2),NK,DrB2l7),NIC*DF03(17) 

Ml JiMUjMD, IST aQ 
LJN6SiOMlTFK,PTlTLE<6) 

QMITFk 

JMS<300) 

RHIi(300) 

PL0T,SAMExY(13) 

PLOT 

R(300) 

RHSI30QI 

$:i(3ooi 

$2(300} 

IITAB 

VM(300) 

2(300) 

AREA(96I I aREA 0(95) ,DlSPt9K),'PT(96) iLAMBDA( 96> I 
RH0<96}»SQRTVV(9ft),TS(96)kTT(96)iVMS0(96) , 
VVK0KP(f6), 

HQA(96}»WSTa(96)i RG ( 96 ) « C2CP ( 96 > » FOR ( 96 ) 
lambda 

6b2(96}fSDNQRM(96) 

(ES2,VVKQKP), (SDN3rM,RH0> 

RCU(96) 

JRCU, LAMBDA) 

LHOJLHE* LBDO.LBDE, LT0;LTE,’ LWOiLWE, ufo.lfe, 
L0iLESTAiLS0iLSE»LDUM(6> I 

MO.NMi NJ.NfCOLSi MAXNj;MAXOL.MAXNM,MAXLe, 
LEOiLEEf LROiLRE»LRD 
l«Ml28)iX2(i28).SLCHN(129) 

SLCHN 

IBLB(6yi 


1,MaX s 0 

130 WRITE <6,1130) 

Call TABPRTOH |L,'39|8} 

write < 6 ; 1150 > < JiX 2 ( J)fSLCMN(J),W( J)iJ»lvNJ) 
IF(LMAX) 180,140»160 
140 CALL TABPRT(6HALLCOM,MAgHA.20,6) 
call TABpRT(5HCI0EX|M*5t5) 

CALL TABPRT(6MIX0RIG|LM0,i2,2) 

IITAB n LBOO 

CALL TABPRT(6HBDVTA6iTABLES,LB0E|3) 

IITAB c LTO 

call TABPRT(6HC0NVTB, tables, LTE, 7) 

IlfAB • LWO 

call TABpRT(6HWAKbTB,TA8LES,LWE,2> 

IlTAB f LFO 

CALL TABPRT(6HCADJWF,TABLES,LFE,8) 

Utab • LO 
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CALL TAbPRT(6HSTATAB,TA8LES,LeSTA,5> 

C FIELD TABLt DUMP 
L » LO 

UMAX s LESTa 

180 0MITFK» .TRUE, 

lines « 

190 MA * MLBIl) 

mb s MUB(L> 
call FHEADlMg,MAt2) 

IF (LINES, ED, (MBpMAtS) ) WRITE (6|1200) 

WRITE (6,1202) 

DO 200 M*MA|HB 

call getix 

write <6,1201) JiMiMUiMOi IStAg, S1( M ) i S2 (M ) • Z{ M ) » R( M ) * PHI 1 ( M ) i 
& CURV(M) , VM(M)ilHM) iRHS<Ml,DS2(Ht 

200 continue 

L * L*LNEXT(L) 

1F(L,LE,LMAX) go to 190 
L « UMAX 


C 6RASE2 DUMP 

300 WRITE <6,iOOA) 

NIC * MIN0(NIC|128) 

NK > M1N0(NK,96} 

GO TO <900|3l0f32O,35O|36Oi37o,39Q), IGODHP 
C FLOBAL 

310 WRITE <6,ie00) 

DO 315 1*1, NK 

WRITE <6,1001) <AREA( J»f Jal,672,96) 

315 continue 

WRITE <6,1002) 

DO 320 1«1|NK 
IP » 672*I 

WRITE <6,1001) <AREAU)rJ»lP, 1536,96) 

320 continue 
GO TO 900 


330 WRITE (6,1003) 

DO 335 1*1, NIC 

WRITE <6,1019) (AKEA<UI#U*I,768,128) 
335 CONTINUE 

WHITE <6,1003) 

DO 340 1*1, NK 
IP s 768*1 

write <6*1006) (AREA(U)»J* IP, 1344,96) 
340 continue 
GO TO 900 

350 white <6,1007) ( ARE A ( I) f I *ll52, 1183) 
WRITE <6*1809) 

DO 355 UliNlC 

WRITE <6,1010) (AHEA(J»tJ*I, 1152,128) 
355 continue 
GO TO 900 


C SLC 

360 WRITE <6,1011) ( AREA< U f 1 >l024, 1037) 

write <6,:i812> 

DO 365 IslilB 

365 write <6;i 013) < AREA( J) f J s 1 . lo24 , 129) 
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GO TO 900 


370 Write <6^iqi4> 

DO 375 UliNK 

write t6,l00l) (AREA{ J)r^al,431»48> 
375 CONTINUE 

WRITE (6’il0i5) 

00 380 U1|NK 

WHITE (6ii90l> (AHEA(vIJ »J=43?,863,48) 
380 continue 
GO TO 900 


390 Write (6,i916> 
DO 392 Uli^o 

write <6,1801) 

& 

i 

392 continue 

write <6*1017) 
WRITE <6aei8) 
9qO continue 


AREAU }|AREA(l4l28),AREA<U256j, 
AREA< I*$0),AREA(I«>178),AREA( t*306), 
AReAn»l00)»A9EA<lA228) , AREA< If356) 

<AHEA( UiI=385,896) 

< AREA! n#ls897,1308) 


IF( IBLBJDiNE.O ) CAUl, T aBPRT < 5HBLBDV, IBLB ,^60i 3 ) 
IF( LUE,EO;0 ) GO TO 1321 
IlTAB « L.DO 

CAUU TABpRT<5H8t.TAB,CHNAM,LDE,3) 

1321 continue 


LSTOP « 5 

GO TO <999i999) , LSTOP 
999 return 


entry EDUMPl 
LMaX « L 
IPtOT « jFAlrSE, 
GO TO 130 


1000 format 
& 

& 

1001 FORMAT 

1002 format 
& 

1003 format 
& 

1004 format 

1005 FORMAT 
& 

1006 FORMAT 

1007 format 

1009 format 
& 

1010 format 

1011 FORMAT 
& 

1012 format 
& 

1013 FORMAT 

1014 FORMAT 
& 

1015 FORMAT 


(//2X,47HSUBR0UTINES ADJWF, BRHS# FLOBAL# WRIBDT, WRiOUT// 
llX|4HARBA,8Xi^HAREAO,9x,4HDlSPillX;2HPTi7x,8HWAMBDA»10Xi 

3HRH0i7X,6HSqrTVV) 

<2X#9Ei3,$J 

<//l3X,2HTS,iiX»2HTT,9X,4HVMS0*7X,|jHVVKQKP|10X»3HWQA;9X, 

4HWSTA,UX,2HRG»9Xi4Hc2CPi10X|3HF6R7 

<7/2X,17h5UbR 0UT|NE P^MOVE// l2Xi5MXlL.llX,.2HSCilOX,3HSCX, 
llXi2HLC,8xi5HLQOpC,loX,3RKCL) 

(IHl) 

(//UX,4hPH12,10X,3HdS1i11X,2hZK#11XV2HRK#2X,5HWEZPT. 

9X|4HDSiO 

(2Xi4Bl3i5i5Xil,?*El3.5) 

<//2X.l7HSUBHOUTlNE REFlNE//2Xi3«lA«,'l6l7/2X,3HlBB,i6l7) 
<//t3X,2HCR,?X,4HDELS,8X,5HDELVMj2k»4HLSTA,3X#3HHU2,l0X, 
SHSGX,10Xi3HSQy*lOX,3HRAV,10x;3HZkV) 

(2Xi3El3,$i2I6i46l3i5) 

<//2X,14h5UBROUTINE SUCF/2X, 6hCURS6« i‘6E13 , 5/ 

2X|6H0V Bi8El3,5) 

(//l3Xf2HRB,iiX«2HZB,loX,3WANG*BX»5HCURVBiiOXf3HSlBiilX« 

aHBI,2X,8HJ2D0Ni,3^,3HHsV) 

<2Xi6ei3i5,2Xi2l8} 

<//2X,14H5UBR0UTINE Oi,C//13X,2HZK;ilX.2HRK,8X,5HWEZPT» 
9x#4MPH|2iHXi2HC2»ilX#2HSP»10Xf3NSPP*10X*3HG5P»9Xi4HGSpPj 
(//13x,2HDS,10X,3HBET,l0Xi3H0DS.9Vfc4HMSTA,?X»4HUISP,llX» 
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& 2HTT,ilX,2HpT»9«.4Hc2cP.10)(»3HFttRi ^ , 

1016 format (//8X,26HSUBR0UtlNES ADDPTB, PLOTRt//ljX, AHANGB i 11X,2HR3, 

i UXi2HZB) 

1017 FORMAT ( /2X, 2WRR/ I 2X , 10613 | 5 » , J 

1018 format (/2Xi2HZZX2X»106i3|5),) 

1019 FORMAT 1 2X # 3Bl3 , 5i 3 1 13 ) 

1130 F0RMAT<//iXi3HCFB»3Xi9H1-U»MA,MB.3X»25H4-PLB#PUB.WF , CHOKE , Su8S3N , 
&3X,44H9-NK,PLBC,RyBC«XCI:IOKe.TAREA,VMBC,WRdST,WCALC, 

45X,32H17*0V(8) |0VP(8) 33- JSUM, VMLBSO > 

1150 FORMAT<///tXi7HSTREAMUN£ TaSlEw/IZXSZHU X2 SlCHN 

& W/( |18iFl2,6,6x2A6iFl2|6i ) 

1200 F0RMAT<5TX|l6HFliU0 TABLE DUMP/128H J M MU MO 1 Si 

& S2 Z R PHll CURV V 

AM B RHS 0S2> 

1201 FORMAT (iX,I3»3I5i l2»2r$l,6»2F12,6,Fii:8.Fl2’.7i2Fll,3#2FlO,9> 

1202 PORMAKIR ) 

END 
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o o cj o Cl n 


•DtCK AUDFPT 

SUB«OUTIME ADDFPK INS*NRTS» jSAVi) 

•addfpt add field points paddfpt# 

input-. 

INS * FIBLD index of first point to Be RELncATEDi INDEX OF 
first new point 

NPTS X number of points to be inserted 

JSaVi X INDEX value of NEW SL ABOVE WHICH THE FIELD U».KEFERENC 
To BE INCHEMENTED BY ONE, x999999 IF NO CHANGE iS Tq b 

common /T^gMig/ 

« 
tt 
tt 

DIMENSION 

equivalence 

common /cb / B(300) 

COMMON /CM / UMS(300) 

COMMON /CPHll / PHIK300) 
common /CR / R(300) 

common /CSl / Sl(300> 

COMMON /CS2 / S2(300) 

common /CVM / VM(JOO) 

common /CZ / Z<300) 

common /CIDEX / M, JjMUjMD, IST aG 
M * INS 

NPT X NPTS 
JSaV X JSAVi 

c relocate field points 

NMOVE A M»l-NM 
MTO X M+NPT 

call M0VEI3,Z(M),Z(MT0)^NmOvE.D, 

1 R(M J ,H(MTOMNmOvE,D, 

2 8(MJ ,B(mTO»,NmOvE,Dj 
call MOVEt3,S2(M),S2(MTOJ,NMOvE,D, 

3 SKMJ iSl(MTO) ,NmOvE,D, 

4 Vm(M), Vm{mTq),NmOVE,D> 

CAUL M0VEI2, JMS(M) , JMS^MTO) ,NMOVE,D,PHltlH)i‘PHll(MTO) ,NM0VE;D) 
NM X NHxNPT 

C CORRECT THE JMS-CHAIN 
MSAV X M 
M X 1 

130 CAUL GETTX 

IF<MU-MSAVI 140,J35,13»» 

135 MU X. MUxNPT 

140 IF(MD-MSaV) 150,145U^9 
l45 X MDxNpT 

150 IF(U-JSAVJ 160#155,155 
155 j I j*l 

160 call SAVtX 
M * M*t 

IF(NM.H) 180,130,130 

180 return 

END 


lhojlhe, lbdo.lbde, l^OxL^ei lWo,l‘^e, LFO.LFE, 

LOjLESTA, lDuM(8), 

MO.NM, NJ.NFCOLS, MAxNJ,MAXQL,MAXNM,MAXLE, 

LEO.LEEx LR0,L«E,LRD 

LIMITS(24) 

fLIMITS.LHO) 
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cj oo n 


•DECK ADJSL 

SUBKOUTINE AQjSl, 

•ADJSL- adjust streamlines By DS2 »ADJSL» 

input, 

ZiR « COOHDINATES along The STREAHlINB 
PHU * streamline anSlbs 

DS2 • desired point MOVEMENT |N THE NORMAL DIRECTION 
C OUTPUT- 

C ZiR « ADJUSTED COORDINATES 


COMMON /CBITS / 
COMMON /C0S2 / 

COMMON /CINNER/ 
COMMON /CMAXIT/ 

logical 

COMMON /CPMU / 
common /CR / 
common /CZ / 

COMMON /IXORIG/ 

& 

& 

& 


BITS, BLANK 
DS2I300) 

INRCTR|RDUM,NINNER(16) ,CNVr(16) 
MAX|T*MAJCTR,GREriNiEDuM 

grefin 

PHI1(300) 

R(300) 

2(300) 

LHO#LHE, LBdO.LBDE. LT0*LTE,' LWO.LWE, LFO.LFE, 
LO,LESTA,lS0*lSE*LDUm(6»; 

MO,NM'i NJ.NfCOLS, maxnj;maxol,maxnm,maxle, 

LEO, lee* L«O.lRE»LR0 


110 


MCTR « MAXOd.MAJCTR) 

CNR * CNVF(MCTR) 

DO 110 M«i,Nm 

R(M) s R(M) t OSa(M)«COStpH|l(M> )*CNF 
Z(M) a Z(M) • DS2(M)*SIN(PMI1(M) )»CNr 


RETURN 

END 
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ono nooooo 


•DECK AOPTSL 

subroutine ADPTSU(HltMUliMUi« jliNEUSL) 

•ADPTSL ADD A POINT ON ThE NEW STREAMLINE •ADPTSL* 

LOQICAU NEHSL 

input- 

mi i FIELD IND^X OF THE NEW POINT 

MUf s upstream.m for new point 

MDi A domnstream.h for new point 

JX « INDEX OF SL OF THE N^w POINT 
NEHSL A T IF A NEW SL» *F OTHERWISE 

ACTION.. 

IF<NeWSL*T) relocate FOR NEW STREAMLINE IN SL-TaBUES 

Relocate for Ngw point in field tables and correct pointers in jhs 


ft 

a 


COMMON /IXORIG/ LHO^HE, LBDO.LSDE, LTOiLTEt LWO.LWE. LFO.LFE, 

LOiLESTA# uOumcB), 

MQ,NM* nj.nfcols, maxn j;maxol . maxnm , maxle , 
LEO.LEEf LROiLRE.LRD 

DIMENSION LIMJTS(24) 

equivalence FLIMiTSfLHO) 

COMMON /SLTAB / Id<l28) iX2(i2S) iSUeHN(l2B) 


integer slchn 

COMMON /CIOEX / Ml J,MU|MD, IST aG 


C 


ADJUST streamline TABLE 

jsav • 999999 

IF( ,N0T,NEMSL) go to 100 

J « Ji 


NMQVE * J*NJ«1 

call M0VEI3iW( J)|W( J tXIfNMOvE.D, 


1 

2 


X2iJI,X2{J*lItNM0vE,D, 

8LCHN(J),SLCHR(J*i),Nm0vE| 


0 ) 


NJ s NJ«1 


JSAV ■ J 


c relocate field points and correct JMS-CHAIN 

100 call AD0FPT(H1i1iJSAV} 


C INSERT pointers IN THE JMS-TaBlE 
M « Ml 

MU • MUt 

MO s MDt 

J • Jl 

I^Tag a 0 

call SAVTX 


C CORRECT UPSTREAM TO DOWNSTREAM POINTER 
M « MU 

1F(M) I20i900»120 
120 CALL GE^IX 
MD s Ml 

CALL SAVTX 
900 RETURN 
END 
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•DtCK BDYPTM 

subroutine BDTPTM(NAME, INTVt, ZDi RDi TO, SlBO ,’DSl , DSlQMA ) 
•BOYPTM boundary point movement #BDTpTMi 


c input« 

C BOT ■ BOUNDARY TABLE 
name m boundary name 

INTVL A index or interval of the INPUT POtNT IN THE BOUNDARY TABLE 

FD * FRACTION POSITION Of TH£ INPUT POtNT IN THE INTERVAL 

SIDD 9 ARC DISTANCE FROM ThE BEGINING OF THE INPUT INTERVAL 

DSi 9 reo»d movement in The clockwise dtrection from the input p 


c 


OUTPUT- 

INTVL • index of interval OF THE OUTPUT POINT 
ZD,RD 9 coordinates OF THE CALCULATED OUTPUT POINT 

angd 9 angle of output point 

CURVD • curvature OF OUTPUT PqInT 

FD 8 FRACTION POSITION IN THE OUTPUT INTERVAL 

StDD • arc distance FROM ThE BEGINING OF THE OUTPUT INTERVaL 

DS1QMA8 #GETP MINUS »ASK» PqINT MOVEMENT BISTaNCE 

boundary table 

index- LBsLBDQiLBDE 

LBNEXTe increment TO NEXT HOUNDaRY 

LBZA * INCREMENT TO TH6 FIRST BOUNDARY POINT (oo BEFOKE COaLLATIO 
CHNAMEs channel WITH WHICH THE BOUNDARY DaTA IS ASSOCIATED 
UP « T OR F FOR upper QR LQMeR B°UNDARk 

LEDEX * RELATIVE INDEX OF L.E, POINT WHBN LOWeR AND UPPER SURFACE 
CONTOURS are connected 

B0NAME,LBA|LBBaNAM6 AND INDEX LIMITS OF SPECIFIC BOUNDARY 

data when boundaries are coallated 

COMHON /ChDATA/ BUT(l)iLBNtXT(i),tBZl(l»; 

1 CHNAMEa),Up(i),LEDEX{l>, 

2 2BT(1)*RBT<1) ,AnG3TU2) 

LOGICAL UP 

integer BDT.CHNAME.BONAME 

DIMENSION BONAMEU)iUBA(l),tBB(i) 

equivalence jBDNAMEfZBT), (lBA.RBT), {LBB.ANGBT) 


common /CBEAM2/ 

1 

LOGICAL 

common /ixohig/ 


» 

dimension 
equivalence 
common /CBDYPT/ 
common /CBITS / 


DH,DZ,yPA,YP9,F,G, DX, YODK , ZM , RM, ANGM,CURVM ;Sl,M 
RZONLYi AnGCHDiSINTVl; XPASQ. XPAB# YPBSQ 
R40NLY 

LHOiLHEi LBDO.LBDE. LTOiLTEV lWOiLWEi LFO.LFEi 
lo.lesta, LSO.lSE, LDO.LDEi LDUM(4)i 
MO,NM, NJ.NfCOLS, MAXNJ,MAX0L , MAXNM|MAXLE , 
UEOiLEEf LRQ*LRE*LRD 
L1MITS(24) 

ILIMITS^UHO) 

ANGDiCURVO 

bits, blank 


common /CFB / LiDUMCFB<33) 
COMMON /CLPlTl/ LFOUT 
LOGICAL LFOUT 

COMMON /CPRINT/ PPDUM ( 6 ) , PDUM ( 6 ) 
common /BLBDy / BL8(60) 

DIMENSION IBLB(6Q) 
equivalence (IBLBiBLB) 

common /REBL / restbl 
LOGICAL RESTBL 

common /CPI / PIiDUMPKS) 
COMMON /CIDEx / M , DUMX< 3 } , I ST aG 
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CJ o o 


dimension 

INTEGER 

equivalence 


ft 


BNAME<iliUBLNxT(l),NSEP(2j,SWREFU) , 

SIGNa»rSWtl>,DsTAR{i),DDsTAR(l) 

bnahe 

fBNAMEieOTJ.aaLNXTiLBNaXT); (NSEP*LBZl)i 
(swref,up),(Sign»ledex);(sw;zbT),idstak,r8T), 

fUDSTARiANGBT) 


logical lower 
DIMENSION NAMEUBU) 
equivalence {NAMiUB,ANGBT(4)) 

dimension SWmOO),OSTARTaoO),DDSTRT(lOO j 


F ■ FD 
SID • SIDD 

IF(F.EO,0. iOR, F.EQ.IJ F«BlTS 
DSiGMA» O'. 

c search for Matching boundary NaMe 

LB « LBFINAMEI 

if<lb,eq;o) calu error; 

I a index of point WHICH flEGlNS THE INTBRVAE 
sFi « distance from point m 
SFiPi a distance From point (UD 
MINI a LB*LBZ1(LB) 

1 a MlNIt3«( INTVL-J.) 

MAXI * LB*L8NEXT(lB)-12 
75 call BAHCH) 

C IF IS THE first of A DOUBLE POINT, BACK UP TO PREV INTERVAL 

IF(SINTVL,NE,0. ) GO TO 8o 
I s U3 

FD * 1, 

IFU.LT-.MINI) call b«RORi 
Go TO 75 

oo if<fd,eq.i; ;or, sid.gt,sintvl) sid*sintvl 

SFI a DSt^SlD 
SFIPI ? SFI-SINTVL 


C IS THE NEW point WITHIN TriS InTeRVaL 
100 IF(SFl) 12o,liR|114 
IFISfipI) 160,16g,lf»0 

C (MOVE COUNTERCLOCKWISE! 

120 IFd.GTiMINII GO TO 125 
DSjGm A a"SF I 
SFI 4 o-, . 

GO TO 230 
125 I a 1,3 

F » BITS 
SFfPl a SFI 
call 8AHC(I> 

SFI a SF1P1*S,INTVL 
GO TO 100 

C (MOVE CLOCKWISE) 

1^0 if(1,lt,maxij go to 145 

DSlGMAi wSFlPl 
SFI ■ SINTVL 
GO TO 230 
145 I a T«3 

F a BITS 
SFI a SFIPt 
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CALU BAHCM) 

SFIPI B SF|*SINTVl, 

GO TO 100 

C CALcULATb COORDINATES QF THE nEU POINT tPROPER INTERVAL FOUND) 
160 IF(F,EQ,0ITS} go to 230 
I^(OSl) 2l0i220,220 
210 F « F*SF1/S10 

GO To 2^>0 

220 F « HBFl^SlO + lSlNTVL-SFlI.FT/ISlNTVL'SlD) 

GO TO 2t>0 

C (NE'4 INTERVAL) 

230 F B SFI/SINTVL 

250 G B l.tF 

RZONUY* '.‘FALSE, 

call bfi 

2D B 2BT<l)*ZM 
RD B RBT(I)*RM 
ANGO s ANGCH0*ANGM 
CURVD B CURVM 
SIDD b SlM 

FU 8 F 

INTVL 8 (1 - (LB^LBZKLB) ) )/3 ♦ 1 


boundary layer adjustment *••*•••*•*••*#•»•#» 

IF( LDE,NE;0 .and, BdUMUsJ.NE.O, ) write (6.288) NaME,ZD,«D. 

• ANQD.CURVD.S1D0 

)F( lOEiEQ'.O ) GO TO 300 
CAUL getix 

IF( (STAG, £0,1 ) GO TO 300 
LOWER B ;true, 

IF( NAMEUB(L) .EQ,''NAME ) LOWER»iFALSE, 

L8L ■ LBDY0L(NAMEiLOWER) 

1F( LBL.EQ.O ) GO TO 300 
NAM8U « IBUB(L8U- 
LFOUT B .TRUE, 

C SEARCH FOR NAMBU IN BL TaBL^ 

LD 8 LDP 

270 IF(LD.GT:uDE1 go TO 300 

IF( 0NAM6<LDi .EQ jNAHBL ) GO TO 280 
LD B LBLNXT(LD) 

GO TO 270 

280 NVAL * fLBLNXT(LU)*LD*6)/3 
LOl « LD 
DO 201 IsljNVAL 
SWT( I )B SWILDI) 

OSTART<n* DSTAR(LDl) 

DDSTRT<U* DDSTAR(LDI) 

201 LPl B LD1*3 

C evaluate SWl FOR INTERPOLATION 

SWl * SlGN(LD)t(0ARCSlNAME,liINTVL)*SlDO-SMREF(LD)> 

1F( NSEP(LD) ;EQ,0 ) GO TO 285 
LDD s NSEP(LD) 

SWSEp 8 SW(LOO) 
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|F(PDUM<I7) ,BO|07) WRIT6(6#1001) NAMBL.SWSEP 
1001 F0RMaT</6X|2iH* t WARNING* •f6X. 

• 26HSEPARATED BL , BOUNDARY* , IX , A6, 3Xi SH9W* , F14 , 6// ) 

285 CALU LFITl(SWT,OBTART,NVAL»SWIiDSTRCrn 
call LFITMSMT,BBSTRT,NVAL»SW1»ANGCi1) 
aNGO s ANSBfSlGN(LO)«ANGC 
CANS « 0, 

1F< ,N0T';LPWBR ) CANG»PI 

ZD • ZDiiSIGN(LD)*0STRC*S1N(AN6D.CaNG) 

RD s RD«SiGN(LU)fOSTRC»COS( ANGD.CANQ) 

1 F( pdum(i»>;eo;o, ) go to 300 

WRITE <6;289) NAHE , NAM0L * ZO , RD» ANGDi CURVDvSIDD, SW I i BSTRC, ANQC 
208 F0RMAT</'/5X#A6i2X#5B16,8j 
289 FQRMAT<//5XiA6#2Xi A6»2X*5E16,8/21X.3E16;81 

300 lfout • ;Fause, 

RETURN 

END 
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•deck 
• BF3 


uo 


8F3 

subroutine Br3(X|Y,ANQ46URV, IA,I3) 

CBNTRAL 3.P01NT curvature 
DIHENSION X(lQ),y(lO).ANQaO)iCURV(tOT 

COMMON /CB6ND / NBCB( 2 ) » AN^E ( 2) .CuRVE( 21 t 2) 
DIMENSION ANGX<3}rCuRx(3) 

NBCB(1|30 
NBCB( 2)*0 
I 8 M 2 « IB .2 


ANGX(1)30, 

IF( 18M27uT;iA ) RETURN 
DO ilO UlAjlBMZ 

call BFACUIDiYi I ),ANGJ{,CURX,3J 

ANG(I*1»*ANGx<2) 

C0RV(U1JTCURX<8) 

RETURN 

END 


•BF3» 
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•DECK BFaC 

SUBROUTINE BrAC(X,Y;ANQ»CUHV|NK) 

•BfACf- eiAM FIT evauuation of angle* cubvature *bfac» 

DIMENSION X{10),N(10)*ANG(10) .CURVdO) 

INPUT- 

x»Y • Coordinates 

AN3 • angle in radians (IF HAsl) 

NK X length OF: X,Y*ANG,CuRV«LISTS 
c output, 

C AN8 • ANGLE IN RADIANS 

C CURV - curvature 

COMMON /CB6AM/ MA^MB| KD, KO^DER 

COMMON /ERASE / A ( 3 ) , B<| ) , YpB ( 1 ) , DA ( 1 ) . ACND ( 1 ) i CHO ( 793 ) 

CAUL BEAM(Xi Y i ANG iNK) 

IF (KORDBR;NE,0) return 

I « 1 

C KA X 1 

KB « eNN«l)»KD*l 

K a t 

C (KbKAiKBxI) 

60 CURV(K)x M»tB{n*2r*YPBU)>^(CH0{l)*(i;*l.5*B(I>*Bn>)> 

80 1 a 1^8 

K a K*KD 

IF(K.KB) 68,90|90 

C (KaKB) 

90 CURV(K)ae*8,«B(I-8),4,*tPB< 1-8 M / ( CHD< I •B ) * (1 . ♦! , 5«YP0 ( I -8 ) «YP 3! I - 

1 em 


Return 

END 
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•DECK BEaCS 

subroutine BrACStX,T,ANC,CURV,S,KA,KB) 

•beaCs. bbam fjt Evauuation of angle. Curvature, •bfaosp 

c anu s 

dimension X(10)«V(lQ}iANG(io),CuRV(l0>*S<l0l 

INPUT, 

X,V . COORDINATES 

anq • Angle in radians uf ma*i) 

ANg(D* gSTiMATED angle AT TRE FIRST POINT (MA®0) 

KA.KB • FIRST AND LAST |NDEx qF VARIaBLBS XiViANGi 6URV*E AND S 
KD - STORAGE INCREMENT OF X, YiANGiCURViBf AnD S 

OUTPUTi^ 

ANG • ANGLE IN RADIANS 

cuRV , curvature 

S - ARC LENGTH ALONG THe CURVg, (L) 

common /CBEAM/ MA*'MB|KD,KORdER 

common /gRASE / A(3),BU),Ypa<l),DA(l>.ACHD(l)iCHDCT93) 

NK ■ KB 

call BFASIXiY.ANGiSIKAiKB) 

IF (KORDBRJNE.OJ RETURN 

I • t 

K ■ KA 

C <K«Ka,KB,1) 

60 CURV<K)« n*2,*YPBn I )/(CHOn )*(i;*i,g*B( I >«Bn n ) 

80 I • t*6 

K s K*KD 

IF(K»NK) 60#90#90 

C (K«KB) 

90 CURV(K)at.a,*B( I*8)i,A,tYPB< I -8 ) ) / ( CHD< I -8 J •< 1 , 5*YPB I I»8)«YP31 I. 

1 81 )} 

RETURN 

end 
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•DECK BFaS 

subroutine 0FAS(X,Y|ANQ.S,Ka«KB) 

«BFAS., beam fit evaluation QF ANGLE AND S •BFAS9 

DIMENSION X(10)«y(10)»ANQ(lQ),S(10) 

INPUT* 

xiv • Coordinates 

ANQ » angle in radians UF HA8\) 

ANG(1)« estimated angle at the first point {Ma«0) 

KA.KB • first and LAST INDEX OF VARIABLSS X i X i ANQi CURV ^E AND S 
KD . storage INCREMENT OF X, V, ANQ. CURV* E i AND S 
KORDERb fl IF ERRORI is To be called when PT3 are out of order 

« I IF RETURN IS TO BE MADE FOR CORRECTIVE ACTION 
« *1 IF POINT 0R08R check IS Tq B6 SKIPPED 

C OUTPUT- 

C ANQ • ANGLE IN RADIANS 

c s .ARC length along the curve, <LI 

C KORDERT INDEX OF 2ND OF ADJACENT 9UT»0F«0RDER PTS <Pl ON ENTRY); 

common /CB6aM / Ma,M8|KD,kOrdER 

COMMON /BRASS / A<3j,BUIiTP8(1)»0A(1).ACHD(1),CHD(793> 

NK B KB 

call BEAMtX(KA) ,Y(KA)»ANG(K a) . lKB-KA*KD)/kD7 
IF(KORDER,NE;0) go TO SOD 

C <K«KA) 

SK B S(KA) 

C (K«Ka*1|Kb| 

I • 9 

K « KA^KD 

70 SK B SK • CHDf U8)«U,*(B< 

1 YP8( I-8jfYP8n.8j)''i5, ) 

S(K) B SK 
IF(K.NK) 08i9OOt9OQ 
BO I # 1.8 
K * K*KD 

GO To 70 

C OUT OF ORDER POINTS 

BOO KQROERb ka*koroer-ko 

900 return 
END 
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»DbCK FArKLIJ 

SURHOUTINE FARFI.B 

cfarflo computation of Velocity on far FtEun boundary -farfld* 

station TABLt 
index- L*L0#LESTA 

ScWOKE, station cHOKE INDICaTOR UDJwE.BRHS.WRIOUT) 

MCL « SHARP corner INDICATOR (BwOTpS) 

MCL 8 field index of control streamline (PTmOVE,FlO0AU 

COMMON /CHOATA/ Xl( 1 ) , LNEXT ( 1 > , MUB ( H , MUB ( 11 . PR IM U ) , 

1 TYPELBaj,NAMEL3<l>tlLB(l),FL9(l)|SlLB(l), 

1 TYp6u8(l)*NAHEUBa), IUB(l),rijB(l),SlUB(l>4 

& VMB(l)|0WDV(l),x2CL{l).SLSWmJ|MCLIl)» 

& ANGTE(l),PTTEm,RSTE(li;rGRTE(l),RGTE(i), 

& ANGEXP(1),BSQEXP<475) 

DIMENSION CHVLE(1» ,ANGLE(i) 

EOU I valence I ScHOXE|DWDV»,<cRVLE,AN$TE) , I angle,ptte) 

INTEGER PRIM.TYPELa.TYPEUB.SCHOKEtll 

C 

common /CR / RI300) 

COMMON vrxOHlG/ LHOfLUEt LBOO.LBDi, LT0»LTE,' LWO.LNE* LFO.LFEi 
• L0,LESTA, l0uM(8), 

» Mo,NM, nj.nfcols, maxnj;maxol,haxnm,maxle, 

ft LEO.LEEr L«0 ,LRE,lRD 

DIMENSION LIMITS(24) 

equivalence (LIMITS, LHO) 

COMMON /CZ / 2(300) 

COMMON /CFRFIN/ at 1NF|MINF»RFFREF,UINF,2DN1»'7DN25 
COMMON /CFRFlD/ NFFJMAXFF ,ZFF(64),RFF(64), 

ft ZDN(25> iDRDN(I5i,UDN(?5)iZW(25i25> 

COMMON /CIDEX / M, J,MU,MD, ISTaG 

COMMON /CPHIl / PH1K300) 

COMMON /CPRINT/ PUDUM( 16) ,PRFF|PRFrO,PRFri,PDDDUM(7> 

COMMON /erase / EDUM(7U) ,Ph 1FF(64) |RDNt25) 

COMMON /CISaOT/ DUM I S ( 30 ) i ADUM ( 6 > 
equivalence (R1,HFFREF),(R25i ADUM(2> ) 
equivalence <Z1i2DND# <Z25iZDn 29) 
c input*#* 

C FIELD tables R,Z 

c VALUES OF m on outer STREaMlINE 

c Z matrix tROM on solution of far field 
c output*#* 

C table of UDN vs 2UN 

C PRFFUO use LFITi(NORMAL) PRFFI»1 use LSPFIT »---*FR0M PHll 
C ' 

C GET R,Z values FROM FIELD TABLES (OUTER STREAMLINE) 

C 

L * LO 

1 M 8 MBEGIN(NJ) 

CALL STANO(M,LiUPFER) 

■•DATA KFAR/6HFARFLD/ 

IFi TYPEUB(L) ,NE',’KFAR ) RETURN 
nf * 0 

2 NF 8 MF*1 

RFF(NF)= R(MJ 
ZFF(NF»s 2(M) 

PHIFF(NF)* PhIUM) 

call gettx 
M 8 MD 
IF( M,NE;o ) go to 2 
NFF 8 nf 

C parabolic fit at end points of FaRFIElD boundary 
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RA 

s 

RFF(l) 

ZA 


ZFF(i) 

zaso 

» 

1,/(Z1"ZA)««2 

A1 

m 

R1*(RA»R1)«Z13323ZAS5 

Cl 

M 

(RA-R1)*2ASQ 

Ri 

9 

•2;*Ci»zi 

Rd 

8 

RFF(NFF) 

Zd 

■ 

ZFF(nFF) 

ZASU 

B 

l./<Z?5«Zd)»«2 

A25 

■ 

R23*(RB^R25)*Z29»#2«ZaSq 

C29 

8 

(RB-R25)#ZASQ 

829 

locate 

* ^>2^.^»C2!i•^25 

endpoint indices 


DO 200 K*i,25 

1F( ZDN(K J ;GE,ZA ) GO To 201 

200 CONTlNUb 

201 UU « K*l 

DO 210 Ksl,29 

1F< ZDN(KJ;GT,ZB > go to 2H 

210 CONTiNUb 

211 LD « K 

c interpolate Points in stc solutio^j tables 
NUH * LD»LU*1 

IF( P«rF;NE,0. ) OALL LSPfIT( 2 PF*RFF,NFP,ZDN(LU* 1 ) |RDN(LU*1) , 
» NUMiO) 

C 

c interpolate Co-ORDlNATb OtRlyATlvES ON FAR-FTElO BOUNDARY 
C 

1F( PRFFI .Nb.O. J GO TO 4 

Caul LFITi(ZrF,PHIFF,N^ F,zON(i,g*l) ^DrDN(LU*1) ,NUM) 

GO TO 555 

4 CAUL LSPFIT(ZFF,PHIFF4NFF,ZdN(LU*1)iDRDN(LU*1),NUM,0) 

C FILL end points OF ZDN|URDN TABLES 

555 DO 556 Ktl,UU 

RDN<K)i Al^Bl*ZPN( K)*C1«ZDN(K)»»2 

556 DR0N<K)= B1*2,*G1«ZDN(K) 

DO 557 K*LDi25 

RUN(K)* A25*B25»2DN(K)*C25»ZDnU)»»2 

557 DRDN(K)= 82542 , «C25*ZDN < K ) 

C adjust derivative at ZUN POINTS CLOSEST TO 
C upstream / downstream stc POINTS 

DZDN ■ ZDN(2)-ZDN(1) 

DZAl 3 ZA*ZDN<LU) 

D2A2 3 ZoNlLUtlJ^ZA 
LUC * LU 

1F( DZa2;GT,DZA1 ) GO TO 550 
LUC * LU*1 

558 AA 3 (ZAwZDNlLUO >/DzON 
SP * B1*2,»C1#ZDN(LUC) 

IF( PRFFI.NE,o, ) GO TO 560 

CAUL LFITi(ZFF,PHIFF,NFF,ZDn(lUC)|SB.1) 

GO TO 561 

560 CAUL LSPFIT(ZFF,PHIFF|NFF,ZdN{UUC),SB»1»0) 

561 assign 562 TQ LGG 

5622 DRDNILUC)* Sp*( ,5*AA>*SB*( ,5»AA) 

GO TO UGO I (562*5) 

562 D^Al = 2g,ZDN(LD} 

DZa 2 = ZDN(LD-l)»Z8 
LUC 3 Ld 
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IF( ABS<0ZA2) ,GT, ABS(OZaI) ) GO TO $65 
LUC • LD.l 

963 AA * (ZDN(LUC)»ZB)/UZDN 
SP • B2$*2,*Ca5*ZDN(LUC) 
ir< PRFFr.NE.'O. I GO TO 565 
call LFlTl<ZFr,PNIIFr,NFF*ZDN<LUC>iSB,l) 

GO To 566 

569 CALL LSPriT(ZFF,RHIFF,NPF,ZDM(LUC>,SB,liOJ 
566 ASSIGN 5 TO LGO 
GO TO 5622 

CALCULATE VgLOCiTtES ON FAR FIELD BOUNDARY 

5 DO XO I»1,H5 
SUM « e; 

DO 9 J«i;25 

9 SUM « SUN*ZIJn#J)*DKDN( J) 

10 UDN(I)« (l,*SUM)fUlNF 

IF( PRFF;eG,0, ) GO TO SO 
WRITE <6. 16) 

write <6;i5) U,ZONn)xRON(I).DRDN(l)»UONeiT.I«li25) 

14 FORMAT<//3X,lHI,|OX;3HZON,l3)(,3HRDN»l3x;4MDRDN.l2Xf3HUUN//) 

19 FORMAT<2X,12,F1776,F16,6,iPe17,6.0PFi5;6J 
C 

20 RETURN 
END 
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•INSTA# 


• nfiCK I;MSTA 

SUBrtOUT INF lNSTAtUNEvJ|l,BASfc,L3iD0»<N8,MA*MB) 
ttiNSTA, Insert a station 

1 . 0 O 1 CAU DOwnB 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 


INPUT- 

LNEW « location in STaT IoN.TaBuE or new station 

LHaSE « LOCATION OF BASE STaTION 

L3 e LOCATION OF dOWNST«EAM |0B UrSTREaHJ STaTION 
DOWNB s T IF L3 is AN UPST«£Am STA, OTHERWISE sR 

MA.MR « new station fiued point index limits 

Z»R»PHI1 field values 


ourpUT- 

unew X station following New station 


station Table 

index- LxLOiLESTA 

SCHOKEx station CHOKE INDICaTO« ( AD JWF , BRhS /WR I OU T ) 

MCL X SHARP CORNER INDICATOR {BlDTBSJ 

MCL X field index of control streamline (PThOVE.FlOBAU 


COMMON /CHDATA/ 

1 

I 

& 

& 

& 


«1U) iLNExT{l),HLaa).MUB{lT.PRIMU)i 
TYPELBU) ,NaWEL8(1>, ILB(1|,FLBU),S1LB(1) 
TYPEUBU) ,NaNEU8(1>i lUBdi *rUB(l> iSlUBdl 
VM8(l)iDWDVa),X2CLll) .SLSWI(l) ,MCL(l»i 
AnGTE< 1» ipTyEd) ,PSTF<ll irGRTEU) iHGTEID 
ANG£XP< II ,BsQEXP(475) 


DIMENSION CHVl6(1» I ANGLEU) 

equivalence ;SCHOKE,DWDv) »<CRVlE,AN5TE) wangle iRTTk) 
integer RHlM,TYPELB,TYPEU3,SCHoKEdJ 




I 


COMMON /ALLCOM/ 

1 

2 

real 

logical 

logical 

common /C0EAM2/ 

1 

logical 

INDEX-t MsMOiNM 

common /CZ / 
common /cr / 
COmmOn /CS2 / 
COMMON /CSt / 
common /CPWII / 
common /cm / 
common /CCURV / 

COMMON /C8 / 

cOhmOn /cidex / 

COMMON /rXORiG/ 


dimension 
equivalence 
common /SLTAb / 
Integer slchn 
common /CATAn3/ 

COmMOn /CBDTPT/ 
COMMON /CBITS / 
COMMON /CMAXIT/ 


MACHAiPSA, TsA,PTA,TTa, AXIA»RGA,GAMA> 
MACHCiPSC,TsC,PTC|TTCi AXtCTRGC»GAMC» 

DAXIT,SCAlEAi1TE,CHOTST 

MACHA(D,MACHC 

AXIa.AXIC 

CHOTST 

OR,DZ,YPA, YpB.F.G, DX» YQDX » ZM , RH» ANGM, CUR VM, Si W , 
RZONLT, ANGcHDiSISTVl, YPaSQ.VPAB# YPBSU 

rzonly 

ZC300I 

R(300) 

$2(300) 

SK300) 

RhU(300) 

JMS(300) 

CURV(300) 

8(300) 

M, JIMOiMUtlSTAG 

lho,"lhe, lboo.lbde, lto*lte» lwo.lwe, LFO.LFE, 
L0,LES>Ta, lDUM(8), 

M0,NM4 MJ,NFC0LS» MAXNJiMAXQL.MAXNMiMAXlE, 

LEOiLEEf lROiLREiLRD 

LIM1TS(24) 

fLIMITSfLHO) 

W(128)|X2(129),slCHN(128) 

dang 

ANGD,CU«V[) 

BITS, IBLANX 

MAX1TiMAJcTr,GREFIN#EDUH 
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COMMON /CPI / R1 iTWOPliPlQ2,Pl04,ToDP6iT0RAD 

COMMON /CPWINT/ RUUMl(3I|PHBriN 

common /CVM / VMI300} 

common /erase / ASL(800» 

common /CFB / UN,DUMCFB{33> 

INTfcGbR BUYNAM,FARFi.D,FREE,riELDtPRES,SOUlD 

LOGICAL UPU»UPO 

-DATA FARFLD/6HFARFLD/I F I ELd/SHF 1 ELD/ * FRgE/AHFREE/ 1 PHES/4HPRiS/ . 
» S0LID/5HS0LIU/ 

relocate to make room FOR THE NEU STATION 

c initialize new, station Value to the 8aSe»station Values 

C CORRECT THE STA^TABlE INUICiES* L-END, U«BASE, L-THREEi L-UPSTREAM 
LN * LNEW 
NMOVE « LN*1 - LiSTA 
LB • LBASB 

call M0VE(2i XKL.N) iX1(LN42o» .NmOVEiD, Xl {LB T . Xl( LN) # 20 , 1 ) 

LESTA « LESTa*2Q 
LT » L3*20 

LU « lb 

IF ( , NOT , DOWNS) GO TQ 60 
LB c LB*20 

LT * L3 

LU * L3 

C update the POINTERS TO THE FiElD.TABIE 
60 NPTS « MB«MA41 
LNEXT(LNJs20 
call STTofiIln.NRTS) 

C*«* DEF INE station-table VALUES FOR THE NEW STATION 
Xl(LN) » ,9»(Xl(LB)*Xl(LT)) 

MLB<LN)=Ma 

MU0(LN)=MB 

prim(ln)4, False, 

X2CL(LN>*RITS 

lower boundary station-table Values 

M s MA 

CALL GETIX 
MX « MU 

IF(DOWNB) MXnMD 
LX s LU 

CALL STANOIMx, LX, UPPER) 

IF(MX-MLBCLX)) 210,220,250 
210 CALL ERRORl 

c lower boundaries df new and base stations aRG on the Same sl 

220 IF(TYPELBILB) .EQVF lELD) GO TO 250 
IF{TYPELB(LB} ,EQ';F aRFLU) go to 260 

c free boundary 

IFCTVPELBILB) ,NE,’FREE ,ANd, TyPeL3(LT);Ne:FREE) go to 224 

TYPEl8<LNJ»FREE 

GO TO 260 

C PRESSURE boundary 

224 IF(TYPELB{LB) .NEVPRES ,AND, T yPEL3 < LT ) NETPRES ) GO TO 230 
TYPELB<LNJ*PRES 
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GO TO 260 

C SOLID BOUNDAHY 
230 TYpfcLB<LMJ*SOLlD 
BDYNAM* NAMELB(LX» 

NAMELB(LN)#BDYNaH 

1LB(LN)=ILB(lY) 

FLB(LN)=rLB(LX) 

SiL0aN)»SiLB(LX) 

ld * uu 

call STANO(MUiLUiUPU) 
call STANO(MDiLDiUPD) 

DSl * ;5«(BAHe$(BOYNAM,ILB(LU).lLB(LDn ♦ StLeaDl-SlUBlLU)) 

if(Upu,or;upd) call ekhohi 

IF(DOWNB) PSis*DSl 

call BDYPTMIbDYNAM, ILB(LN),2(M),R(M),FL8<LNy,SlLBaNI,l»Sl,GMA) 

IF(GMA,NE.0<1 call ERHQRi 

PHfl(Ml=ANGD 

B(M> ■ ) 

VM(M) ■ ',5»(VM{MU)*VM(M0)) 

IF<VM(M) ,EOiO. ) VM(M)sVM(MU^1) 

GO TO 30f) 

c infield Boundary 
250 TYpeL8(LN)*ri6L0 

ISTag *3 
call SAVIX 
NAh£LB<LN)*IBLANK 
260 ILB<LN)=0 

FLB(LN)sB1TS 

SIlB<LN)«BITS 

upper boundary station-tablb Values 

300 M « MO 

call gettx 

MX 8 MU 

lF<DOWNbJ MX.MD 

call STAN0(MX, lx, UPPER! 

1F(MUB(LX)*MX) 310,320|350 
31.0 call ERRORl 

C UPPE0 boundaries 0F NfcW ANp BaSE STa^IoNS aRE ON ThE SaHE Si. 
320 1F{TYPEU0ILBI .EQ,"F IBLD) GO TO 35p 
IF(TYpeUbILB) ,E0,*FARFLU» go To 360 

C FREE boundary 

LD a LU 

CAUL STAN0(MU,LU,UPU> 
call STAN0(M0,L0|UP0> 

IF (TYPEUBIUB) ,NE,FREE ,AND. TYPEUB(LD);NE,PREE) go to 324 

TYp6tJS(LNJ^FREE 

GO TO 360 

C PRESSURE boundary 

324 IF (TYPEUB(LB) .Ng.PRES ,ANU, TVPEUB(LD) JNE .PRES) GO TO 330 

typEub<ln)apres 
G o TO 360 

c SOLID boundary 

330 TYpEUB<LN)sSOLiP 
bdynam* naheubIl^*) 
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NAMEU0<LN)*BDYNAM 
1Ub(LN)=IUB(LX) 
rU 8 (LN>=rUB(LX) 
s;uyaN)tsiuB(i,x) 
ld « lU 

call, STANO(MUiLUiUPU) 

Call stano<md,lD|Upp> 

1F(,N0T,UPU :OR. .NQT.UPU) CALL ERRORI 

DSi s ;5 »(oArC8(BDyNAM, 1UB(lO», !u®(LUMi ♦ SlUB ( LU ) *SIU0 ( LD ) ) 
IF{ ,NOT,DOWN0) 0S1»»DS1 

call 8DYPTM(BDyNAM, 1uB<LN).Z<M),‘’«H),PIJB(lNj,S1UB(.LN),PSi,GmA) 
IF(GMa,NE.O, J CALL ERROHJ. 

PHIl(M)* ANGd-PI 

8 (M) s . 5 «( 0 (MU)«'B(MU) I 

VM<M) s ,5«( VM(MU)*VM(M[)) ) 

IF(VM(M)VEQ,0, ) VM(M)sVM(mU-1) 

GO TO 400 


C INF16LU boundary 
>550 TYPEUB(LNJ*FIELD 
ISTAG 8 3 

call savix 
NAHEUB<LNJ»IBLANK 
J60 IU0(LN)=O 

rU0(LN)=BlTB 

S1U9(LN)*BITS 


c define the field points by Cubic polynomial interpolation on sl>s 

400 M * MA 

RZONLY8 .TRUE, 

1F(TYPEL0(LN) .EQ.'SOLIDI go TO 420 
410 call gettx 

DZ s ZImU)-Z(MU) 

DR 8 R<MU)-R(MU) 

F « , 5 

G * ;‘5 

ANGCHDs ATAN3(DR,UZ,'PHIKM0> ) 

VPA 8 PHI1(MU)-ANGCHD 
VPB 8 PH11<MD)8AnGCHU 
mSV z M 
MUSV * MU 
MDSV = Md 
M * MD 

call getIx 

ISTAGD8 ISTAG 
MD s M 
M r MSV 

MU 8 MUSV 
IF( iSTAGU.’EQil) YPB8,YPA 
RZONLY8 .FALSE, 

CALL BFI 

Z(M) * ZfMUj^ZM 
R(M) s R(MU)*RM 
PHI1(M)saNGCHD^ANGM 
VM(M) X F«VM(MD)tG*VM(MU) 

0<M) 8 r*BlMn)t6»8(MU) 

C CHECK FOR POINTS ON A SLIP LINE 

1F(M.E0,MA ,0R, W(J),NE,0,) go to 420 
Z(M) * 75a(Z(M-J,)*Z(M) ) 

M 8 M»1 

call gettx 
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M s HSV 

DZ m .2S*{Z<MU5>V)-Z(MU)*ZtMDSV)«Z(MD>) 

DR * ,25*»(R(MUl»V),R(MU)*R(HDSV)»R(M0n 

Z(H^1)» Z(M)-DZ 
R(Mfl)» R(M)-DR 
Z(M) » Z(M)^DZ 

R(M) s R(M)*D'^ 

420 M « M*1 

IF(M-MB) 4XO,425|SOO 
425 !r(TYPEU0(UN) ,NE, 'SOLID) GO TO 4l0 

C CWECK FOR OUT-OF-ORDER POINTS 
500 NORDER* 0 
502 NORDERc NORUER«l 

lF(N0RDfcR.G£,20) CALL ERHORi 

MXi * 0 

MAPI ■ MA*1 

MSV ■ MA 

S2(MA), 0. 

DO 520 M,MaPi,M 8 
DR * R(M)-R(fi»l) 

DZ ■ 2(M).7(M»1) 

S2(M) « SP(M,1 )kSQRT(DH«DR*DZ*DZ) 

call getix 

if<w(j),eq;o.) go to 5ia 

ANQ2 * ATAN3(DR,UZ|PHII(M*.i) ) 

AUANG s ABS(DAN6*PIQ2) 
lF(MXl,NE.fl) GO To 515 
1F( ADANG,GE,PIQ2) M)KlaM§V 
MSV * M*1 

515 1F(ADANG;GB,PIQ2) MX2*M 
GO TO 520 

518 IFMM-1) ;eQ,MX2) MX2»M 

520 continue 

c define the field RT locations BT upstream area distributions 

IF(MXI.EO.O) GO TO 999 
MXl s MAXO(MXl.NORDERrMA> 

mX 2 » MIN0(MX2'*NORDERrMB> 

WRITE <6;i550) MX1,MX2 
1550 F0RMAT<14H I NST A.Mxi , MX2 , 2 1 6 » 

MXI * MAX0(MX1#1,MA) 

MX2 a MINO(MX2tliM0) 

c add up upstream areas 

M a MXI 

CALL GE^JX 

ASL(i)a o; 

562 MUMl * MU 

M 8 M*1 

K « K*1 

CALL getix 

area a SQRTnRIMU)*R(MUMl) )»(R(M'J)»RlMUMlU ♦ 

1 (ZIMU),Z(MUM1) )a(Z(MU)sZ(MUMi) J) 

IF<AXIA) AREAa(R(MU)*R<MUMl)»aAREA 
ASL(K)a ASL(K«lltAREA 
If<M,LT|MX2) GO TO 562 
ASLNK a ASL(K) 

C INTERPOLATE FOR COORDINATES 

DZBA a Z(MX2)«ZtMXl) 

DRBA a R(MX2 )«R(mX1) 
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DRSQBAk 0RBA«(R(HX2)*H<HX1) ) 

RMaSO ■ R{hXi)*RjmXi) 

DVH8A « VM(MX2>*.VH(MXU 
M • MXi*l 
K *2 

564 r * asl(k)/a$unk 
Z<M> « r(HXl)*r#OZBA 
R(H) 8 RlHXi)»r«ORBA 
IF( AXIA) R(M)3SQgT(RMASO«F*DRSOBA) 
VM(M) 8 vM(MX1)*R«DVMBA 
M « 

K 8 K*1 

|F<M,uT|MX8) go to 564 
GO TO 502 

999 LNEW 8 LN*20 
RETURN 
END 
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noon 00-000 ooooooo 


• DECK PTi'iOVE 

Subroutine ptmo.ve 

•ptmove point movement along streamlines »PTmOVe» 

c Point movement along streamlines to obtain an orthogonal grid 


c 


INpUT^* 

= coordinates 

pnu s angle of the streamlines 

51 = distances along the streamlines 

DSlDMps STREAMWISE DAMPING FACTOR (NORMsO,) 

DslDPis additional factor on DSlDMP FOR 1ST INNER ITR (NORM*. 5) 
ICOB = NrR REFINmTS TO USE SLC-aNGLES , cUR V aT 3DY PTS (NORMrO) 

output- 

52 : distances ALONG THE QRThoGONALS 

s adjusted coordinates 
PH ll = streamline angles (ADJUSTED POINTS) 

Si = distances along the streamlines (ADJUSTED) 


station Table 
Index- l=lo,l£Sta 

ScHOKEs station choke indicator ( ADJWF.bRHS.'WRIOUT) 

MCL = SHARP Corner indicator (bldtbs) 

MCL = FIPLD index OF CONTROL STREAMLINE ( PTMOVE , FLOB AL > 

Common /choata/ xk d ,lnext( li ,mlB(D iMubc u ,prim( d , 

1 TyPElB(I) ,NaMELB(1). IL3(1> ,FLB(1) #S1LBU> I 

1 TYPEJSd) ,NAMEU8(1>, IU9(1> ,FUB(1) ,S1UB (Di 

& VMa(l)iDWDV{l),X2CL{l)»SLSWI(l),MCL(l)i 

& ANGT,E(l),PTTE(lj,PSTE(l) ,FGRTE(1),RGTE(1 )i 

'S ANGEXP(l) ,aSQGXP(475) 

CRVLc(1>iANGLE(1) 

(SCH3)<EiDMDV), (CRVLE.ANgTE) ,< angle, PTTF.) 
integer PRIM,TYPELB;TYPEUB,SCH0KE(1) 


dimension 
CUUI valence 


Common /eg / 
COMMON /CBDYPT/ 

Common /cheam2/ 

& 

logical 

Common /cbend / 
common /crits / 
Common /ccurv / 
Common /cedum?/ 
Common /cfb / 

& 


COMMON /CIDEX / 

Common /c inner/ 
common /cm / 

COMMON /CMAXIiT/ 

Common /cphU / 

Common /cpi / 

Common /cprint/ 
Common /cptmov/ 
logical 

Common /cr / 

Common /csi ^ 

Common /cs2 / 

common /ctolrl/ 
common /cvm / 


B(300) 

ANGDiCURVD 

dr,dz,ypa,ypb;f;g, dx,yqdx,zm.rm,angm.curvm,sim» 

RZONlY, ANGCHD.siNTVL, YPASU; YRAB , YPBSO 
rzonly 

NB03(2) ,F3(2) 

BITS, BLANK 
CURV(300) 

IGODMP 

L, MA,MB,LX,IKrIKDlR,IKA, IK3.‘ 

NK,K, ADS1,XCH0KE,ADS1LB, A0S1UB,GHAL8*GMAUB, , 
NIC,DF3(17) 

M, j;mu,md, ISTAG 

lMRCTR,RDUM7NrNNER(l6) ,CNVF(16 ) 

JMS(300) 

MaXREF,NREF!N;gREFIN,TL 

PHI1<300) 

PI ,TW0PI,f»IO2,Pi04,T00GG.T0RAD 
CPDUM(6) ,PDUM(2b) 

V6LP0T, IC0B,'NOnENS,FBASTG 

velpot 

R(300 ) 

31(300) 

S2(300) 

DT0lRL( 6) .DSlDMP.’DSiDPl 
VM(300) 
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COMMON /CZ / 

Common /erases/ 

& 

dimension 

EOUIVAUENCE 

integer 

COMMON /IXORIiG/ 

& 

& 

S 

COMMON /SLTaB / 

integer 

Common /trquBw/ 
lui^ical 


XlL( 128) |3C(128) ,SCX{128 ) iLC<128) #L00PC(128?» 
KCU128), 

PHI2(96),0Si{^6);ZK(95),RK(96).WEZPT(96).DS1C<96) 

RHI1K<96) 

(PHIlKiDSlC) 

NEZPT 

LMO.LHEi LBDO,LBDEi LTO.LTEi LWOiLWE, LFOiL^Ei 
LO,LESTA,LSO,LSE,’LDUM(6>, 

MO»NMi MJ.MFCOLS, M AXN J , M AXOL . M AXNM i M aXLE i 
LEO.lEE* lro.lhe.lrd 
W( 126)i X2(1?3)VSLCHN(128) 

SLCHN 

err.errmaj, inerr.prerr 

ERRiERRMAJ# INERR.'PRERR 


Integer field. solio.'te 

DaIa FIELD/SHFIELO/i N0MCL/6HM0 MCL/, SOL 1 0/5HS0L I D/ » TE/2hTE/ 

Data le/2hle/ 


IGUDMPs 3 

C DS^ MeLaXaTiON factor 
RoSl = i;- 0 SlDMP 

IrnNRCTR:EQ.’0) RDS1 sRDS1»(1.=;DS1DP1) 

c USe parasolic =no conditions on the orthogonal spline fit 

NRCBIDsO 
N8GB(2)=0 
Fall,) s o'. 

Fg( 2 ) = o'. 

C build arrays of aRo distance along control streamline 

L = LO 

LAST = 0 


C FIRST point on CONTROL STREAMLINE 
210 IF<L,GE1LFSTA) go to 900 

ic = 1 
LCU) = L 
scd) = bits 
XcNTRl* X2CL*i.) 


220 


230 


232 

C 

C 


XiL‘;iC)=Xi(L) 

IFISCII) ,NE'.91TS) GO TO 2A0 
MA s MlB(L) 

mb s Mu8{L) 

Do 230 M=mA,M3 
CaI-L GE^IX 

IF(X2< J)»XCNTRL) 230,232,230 
conUnue 

IFIIC'.EQ.I) GO TO 245 
Go T,0 243 

IF(IC'.EO.I) GO TO 240 
(the upstream OL of THE REGION IS 
the control STREAMLINE) 

Li = LC(1) 

McL(Li)=Mu 
ScU) = Sl(MU) 


AT A T.'E, and does NOT INCLUDE 


240 Sc(IC)s Sl(M) 
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LC( IC)= L 
LoO^'C(IC)- 2 
Mc‘*lL)= M 

KCL( In)=M«ML'§(L)*l 

C iS control Sl included in the stATlON STHEAHLINES 

I(^(M;lT.mL 3I'L) ) CALL ERRORl 
(M. lE. MU3('L > ) DO TO 24 4 

C control Sl does not cross This ol, check for field boundaries 

243 iFdYPELBIL} '.ME-EIELU .AND'. TYPeUB ( L ) . NE , F lELD ) CALL ERRORl 
MCL(L)= noncl 

GO To 245 

244 M s Mn 

Call getix 


C INnfc:^ TO the NE^T STATION 

24& IF(PRIM(L) '.EQ'.l .AND, IC.NE'.l) GO TO 250 
L s L*LNE)(T(L) 

= IC+1 
Gq to 220 


C 


LAST POINT along CONTROL STREAMLINE 
2i?0 NIC a ic 


LOOPC(l)=i 
LoOPct IC)= 


1 


c average Spacing between ol-s 

OLUI.STs (SC Me) -sell) )/FLOAT{NIcil) 


c CArRT our ORTHOGOMALIZATION for Ji)-pRIHART and (2>aALL other ol»s 
LOOP s 1 

Go to 30d 


c KEoEFInE primary sc*s 

260 L S Led) 

N = MCL(L) 

SCM) s Sl(Ml 
L = LC(NIC) 

M = MCL(D 

SC{NIC)=Sl(Ml 

c LOOP Through stations to determine scxiic) (LOop *2 only) 

c Sex s DESIRED POINT MOVEMENT ON THE CONTROL STREAMLINE 
IF(NIC,Eq'.2) 30 TO 500 
Ic =1 

265 Ic = IC*1 
U s LCdC) 

C partial QL with no MCLi USE MIDDLE SL TO EVAL. SCIIO 
IF{MCl (L) NE'.'nOMGL) so to 276 
MSV r (ml3I-'L)*MU0(L))/2 
KCLMC)=MSV-MLB(L) + 1 
c search upstream 

M r MSV 

L)( * L 

272 Call getix 

M S MU 

Call stano(m»lx, upper) 

IFIMClCLXI'.EQ'.NOMCL) go to 272 
SlUP = Si(Ml 
^ = MCL(LX) 

SCUP = SKMI 

c search downstream 

M s MSV 


2m 



c 


274 Cal'- ge^ix 

M = MD 

Call sTANor'i.LX.UPPEH) 

IF<MCL(LX) *. EQ'. NQMCL) SO 
SiuW = SKMl 
M = rlCL(LiX) 


TO 274 


SCUW = Sl(Ml 

I'iTER'^OLATe . 

SctlCJs SCliP ♦ ( SCQkI-SCUP > * (Sl( MSV ) 


*.S1UP)/(S1DW-S1UP> 


276 lr(LOOPC( IC>7 nE, 1) GO TO 265 
27H XlA = XlL(i) 

Xia s XlLtNlC) 

SCA s SC( D/CXlG-'XlA) 

Scd = Sc(MfC)/<X 13 -XiA) 

2B0 ScXnC) = (XlLMC><=XlA)*SCa*(XlP-rXlU( IC) )*SCA - SCMC) 

C,, EmU loop TO GvAl SCXMC) 

C*»^«^CAlCULATE angle and arc length along THE ORTHOGONAUS 
300 ic = 1 

302 !r(LOaP'.NE'.LOOPC( IG) ) GO TO 450 

C UST I 1:aU'^3TaTI 0N or PREVIOUS REGION (ALREADY ORTHOGONAL I ZED ) 

IriL.EQ'.LASn GO TO 450 

Rzdnly= .false'. 

Ma = HlB(L) 

Ma = MijB(L) 


boundary surface 

IF( ICOB-MREFIN) 


303 


304 


angles, PHIifMAl « PHI1(NB> 

303i 306,306 
PHU(MA) = ANGn , 

Ph11(MB)=ANGD-PI 


relocate z.’r to allow for double sl=»s 

306 Nk = MB-MA»-1 


M s MA 

K = 1 

308 ZK(K) s Z(M) 
Rk(K) s R(M) 

PhUK(K)=PHU(M) 


WEZRT(K )=0 

Ir(W(.J^;,NE'. 0.“ '.OR. K.EQ.l) GO TO 310 
WEZPT(K-' 1 )s 1 

ZX(K-l)=. 5 »(ZX(K)+ZK(K 8 l) ) 
RK(K-i)=. 5 »(R 4 (K)*RK(Kal) ) 

GO iO 312 


310 K s K-*-! 

312 M = M*1 

Ir(M.LE‘.M8) GO TO 308 
NXX s K-1 


« BEaN fit TO GET PHl2 8 S2 

PHl2(i)=PHll!<(l)+Pl02 

•S2(MA)= O'. 

Call bfas(ZK,rk,phI2i s2(MA) , i,nkx) 
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C commute DEVIATIOM from 90 DEG BETWEEN STREAMLINE AND ’ORTHOGONAL’ 
C INtEURaTE to obtain PT movement along SL'S reo'd for orthogonality 

PMI2(1 )=PHl2ll)-(PHIlK(l)*P!Q2) 

DS1(1)= O'. 

K = 2 

M = MA+1 

31A PhI2(K)=PmI2IK)-(PHI1K(K)»PIQ2) 

DS1(K)= Dsi(K-l) + ;5«{PHl2(K)4>PHi2(h-l) ) » ( S2 ( M ) = S2 ( M-1) ) 

W s K + l 

M = M + 1 

IFIK-NKX) 314, 314, 315 

C locate back PHI2 ANO S2 IF POUBLE SL OCCURED 

315 IrtNKX.EQ'.NK) GO TO 322 

^ = NKX 

316 IF(WE7PT(K)) 317,318,317 

317 M s K-1*MA 

NmUVE = -(MKX.K+1) 

Call M0VE(3, DSKK) ,DS1(K*1) ,NHOvE»1. S2(M) .S2(M + 1> ,NM0vE,1#' 

& ^^/EZPT(K) , WEZPT(K*1 j ;nmove,i ) 

NkX s nkx*i 

WE^PT(K)=0 
318 K s K-i 

IfCK.GE. 1) GO To 316 
IFINKX.NE’.NK) CALL ERRORl 

C (gOUNPAHY Sl-i-TOLERA'JCE) 

322 TqlSi s .02»S?(mB)/FLOAT(NK) 

c CORRECT Possible jog at double streamline 

Do 328 Ks2,,nk 
IF<WE7PT(k)) 326,328,326 

326 MsMA+k-1 

DZ = Z(M)-Z(f1«l) 

Dr = R(M)*R(M»l) 

PMllAVs .5«(PHI1(M)*PH11(M-1) ) 

CS s COS(PHllAV) 

Sm s SiN(PhIIAV) 

S2MMM1S DR«CS^DZ«SN 
IF(S2MMMi'.GTVo'. ) GO TO 327 
Z(N-lJs ,5#(Z(M)-»-2{M-i) ) 

RM-D= ,5*<RtH)-’R<M-l)) 

Z(M) s Z(M-l) 

R(M) s R(M-l) 

S2<^> = S?(M.i) 

PwIKm )=PHI 1A7 
PHll(‘-1 = l)=PHriAV 
DS1(I<>= DSl(K-l) 

GO 10 328 

327 SlJOG=(DZ*CStDR*SN)/2, 

Ds1(K-1)=DS1/K-1)+S1J0G 

DS1(K)=DS1(K)«SU0G 

)=<52(M-1) - ,5»S2MMM1 
S2(M) s S2(M»1) ♦ S2MMM1 

328 Continue 

c evaluate ADSI FOR PROPER SPACING BETWEEN OL-S 

329 lFtLOOP-2) 3295,3302,3302 
3295 If(PRIM(L) '.EO.O) CALL ERRORl 

c primary ol-s 

•<K = MCL(L)-MA^1 
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if(typelb(U':eq.le) kk^i 

IF(TYPEU8(L) .EQ.LC) KKsNK 
AQSI = -nSliKK) 
fin 10 3303 
C RfcfiULAW OL-S 

33i)2 Kk s KCL(fC) 

Aniil = SCX( IC)-=OSl(KK) 

C check to see IE magnitude of DSl IS REASONABLE 

3303 rF('AQs(nsi(MKn .LT. ( ,5«(S2(MBUnLDlST) n GO TO 3304 
Write (6ii330 ) xkdiL 

lF('^f^EFIN'.GE72> CALL ERRORi 

C correction due to streamline curvatures & damping 

3304 DsKl)=DSi(li*AOSl 

DSl)i<i)=0'. 

K >2 

M = Ma*1 

3306 Dsl<K)= DS1<K j+AOSl 

DslCCKIsDSlCI-K-l)* ,5«(CURV{N)»nsi (K)*CURV(M-1)#DS1 (Ks1> > 

A «(S2iMWS2(M-in 

R = K*1 

M = M + i 

IfIMD-M) 3310.3306»3306 
3310 AdSI s -DSICI’KK) 

K = 1 

3312 DslC<y:)=DSlCJKl+ADSl 
IF(051(K)*D31C(K) ) 3313 • 3314 . 33i4 

3313 DS1<;K)= D Si I K ) / ( 1 . «;DS1 C ( K ) /r,Sl ( K > ) 

3314 OsKKjs DSl(K)»RD5l 

K r K + 1 

If<Nk.K) 3316.3312i3312 

C LOwtR and upper bOijNdaRY POINT MnvEHENT 
3316 A[)bil s o; 

ADS^LRs DSl(i) 

AnSlUDs sDSKNK) 

C MOVE THE LOWER BOUNDARY POINT 
K = 1 

332 GmALB = 0'. 

GmAWP = O'. 

M = Ml'G(L) 

Call getix 

lF(TypEL8(L)7;vlE.TE) GO TO 3321 

adsilbs o; 

Go lO 3324 

3321 IrUSTAG.EQ.l) GO TO 333 

I F ( Nqoens-MREF I N ) 3323, 3322.'3322 

3322 If(TYPELB(L)VEO.FaRFlD ,0R. T YPElB ( L ) , EQ . FREE .OR. 

-s TYPELQ(L) ;EQ;pRES> go to 3324 

3323 1f(TYPELB(L)7nE.S0LID) GO TO 334 

3324 Ma = MLd(L) 

IfUDSILB) 3325,3325,3326 

3325 IFIMu'.nE.O) ADSlLHa AM AXl ( ADsILB,’ 5* { SI I MU ) sSl ( M ) ) ) 

Go TO 3327 

3326 InMD'.NE.O) ADS ILRa AM I N1 ( ADSlLB V ^ 5* ( Si ( MO > aSl ( M ) ) ) 

3327 Call BDYPTM<NaKELH<L> , ILB(L) ,Z(MA) »R<MA> ,FlB(U ,S1LB(L ) , 

& ADSiLB, GMALB) 

SiCMaIs S.l(MA)+AOSlLa + GMALB 
IFITYPELB(L)'.“E0.TE) ANGTE,(L)sANGI) 

C JUMP OVER RELOCATION OF ANGLE/CRUVaTURe IF ICOB (INTERIOR POINT 
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c curvaturp formula om boumdaRV) is Ltss Than or equal to nrefin; 
IF(NREFIN 'lE'."ICOB ,0R. (ISTARrEQ.2.AND.B(MA) .GT.O.)) GO TO 333 
PhU(Ma> = aNgd 
CuRV<MA)=CUR\/D 

333 Ma s MA+1 

K - 2 

c MOVE, The upper boundary point 

334 M =HUR(L) 

Call f.etix 

Irn^YPEUB^.uVME, TE) go TO 33^ 

AOiilUSr 0. 

GO if) 3352 

335 1fUSTAO.EQ;1 ) GO TO 336 
IFINODENS-NREFIN) 3351 . 3350 V3350 

3350 1F<TypeUb(L )'.‘E0.FaRFLD .OR. T YPruB I L ) . EO . FREE .OR, 

5 TYPHUBfL > ’.EQ'.PRES) GO TO 3352 

3351 iFiTVpEUBfD.’NE. SOLID) GO TO 338 

3352 Mg - Mu8(L) 

iFlADSlUB) 3355,3355,3356 

3355 IFIMO'.NE.O) ADSIUB* AM AXl ( ADSlUB 1 5* ( Si ( M ) -SK MD ) ) ) 

Go To 3357 

3356 IFIMU'.NE.o) ADSiURs AM I N1 ( ADSiUB 5<K SI ( M ) -SK MU )) ) 

335 7 Call nOYPTM(NAMEU3(L) • I U8 ( U . Z ( MF3 > . R ( MB ) , FUB ( L) , SlUB ( L > , 

6 ADSiUBiGMAuB) 

SlIMBls Si(M8)-aDS1UB»GMaUB 
IFITYPEUB(L) :EQ,TE) ANGTE R ) * ANGD-P I 

IP(NRf:FlN'.LE?lC08 ,OR. (I ST AG .‘EQ 2 . AND . B ( MB J . GT . 0 , )> GO TO 336- 

PhIMMB)saNGO»PI 

CuRV (MB >s«CURVD 

336 MR s MB-1 

c check for non prim stations extending beyound The ends OF The bound 

338 IF(PRIM(L) '.eo;!) GO TO 340 

IF< (GmALB+GMAJB) ,NE; 0, ) CALL ERRORl 
GQ To 348 

c PRiM stations, if EITHER 'GET MINUS A3K» VALUE IS LARGE 
c Correct other boundary. 

340 Ir(IC;NE.i) Go TO 342 
c (fi^st station of The Region) 

GmA a AMAXKGMAlB.-GMAUD) 

Go TO 345 

C (last station of the REGION) 

342 GhA a AM I M 1 ( GM AL8 , -GMAUB ) 

345 AdSI a ADSlTGMA 
ADBll.Ba GMA-GMALB 
ADSiUBs iOMA-GMAUD 
If(ABS(GMa) .GE'.TOLSi) GO TO 332 

c MOvfc THE Interior points 

348 M = MA 

Go TO 410 
350 CALh GETIX 

DS1TK)= DS1(K)*ADS1 
lF(QSi(K)) 360.400,380 

c (MOVE point Opstream) 

360 iFCflU) 36i,‘38l,36l 

361 DelSI a Sl(M)'^Sl(MU) 

DSlS'K)a AMAXK».5ttDELSl,AMlNl(DSi(K) , ,25*PELS1> ) 

G = sDSlfK)/DELSl 
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F =' r.-G 

Fr = sG 
Dr = R(M)«R(MU) 

5 Z(M)®Z(MU) 

PH I A s PHll^nU) 

PWIB s PHllf'rn 

CuHV<M)=CURVfMU)»G. ♦ CURVCM)*F 
Go TO 390 

C (mUVF. point DOWNSTREAM) 

300 iFCpDi 38l.36l*38i 
381 DELSi s Si(MD)»21(M) 

DSUK)= AMAXl( = .25»0ELSl,AMlNl(bSl(K) . .5#DRL'S1) ) 

F s D,S1 (K)/DElS1 

G = I'.-F 

FF = F 

Dr s r(md)-R(M) 

DZ = Z(HD)«Z(M) 

FMlA = PHJlfM) 

PhIB = PhJK'MD) 

c check for downstream leading edge stagnation point 

Msy = M 

M = mD 

tAl.L GET lx 

md = m 

M s MSV 

iFr ISTAG'.NE'.l) GO TO 383 
LX s 0 

yALL STANO(MDiL.X, UPPER) 

PHIS = ANGLEU.X) 
yo TO 390 

383 CURV(f.,)-cuRVi':^)uG ♦ CDRV<mD)*F 
390 AnGCHOs ATAN3(DR,nZ,PHIA) 

YpA s PHIAwANGCHD 

Ypd - phib^angchd 
c Call BFI 

Yoyx s F*G»fG*yPA-F*YPB) 

ANGH = YPA»f3i *G-2i )»G *■ YP8* ( 3 «F-2 1 > *F 

P{M) s R(M) 4. (FF«DR*Y0DX»DZ) 

Z(M) = Z(M) + (FF»DZ-YODX«bR) 

PhU<M ) =angchd+angm 

Sl(M) = Sl(M)+nSl(K) 

400 M - M*1 

K = K + 1 

410 If(M-MB) 3504350. 450 

C index to the next STATION 

A50 IFUC .GE .MIC) GO TO 470 
IC = lC+1 

GO TO 302 

C LOOP AGAIN through STATIONS IN THE REGION 
470 IfILOoP'.eq'.Z) go TO 500 
LOOP = 2 
Go To 260 

c continue to next region 

500U =LCtNIC> 

Last = l 

IF(X2CL(L) ’.EO'. BITS) L = L + LNEXTfL) 

Go To 210 
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900 RETURN) 


J.330 RoHHAT(45Nj 
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Enu 


Of^THOGOMAL LIME ADJUSTMENTS 
U iRpAS.OMASLY LARGE', ^PTMOVE)) 


AT STAsr6,3»4H (La 
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<70000 oo o oo o o o o oo oo o oo o 


•DECK REPINE 

SUBROUTINE R|FINS 

tRBflNE REPINE the. GRID BT SUBDIVIDING PREFINE* 


INPUT* 

Z,R,PHli;S$,S2|VM,B FIEtO VaUuES 
/GREPIN/ data except S^S 

cRxsi s NEW SI. extension criteria 

CRXSS 9 EXTENSION CRITERIA FOR NEW Ol IN REGION WfTW SOME SSwFWflW 
CRXOL • NEW OU EXTENSION CRITERIA 

CRXE s EXTENSION CRITERIA FOR NEW OL WBIgH CROSSgS SONIC LINE 

C«XC » EXTENSION CRITERIA FOR NEW OL WHICH CROSSgS SHOCK WaVE 

crmach* upper magR number limit For ol sxtension 
CRXSL « NEW su extension criteria 

CRXSS a extension criteria for new ol in region with some ss-flqm 
CRXOL a NEW OL EXTENSION cRiTeRIA 

CRXE * extension CRITERIA FOR NEW Ol WHICH CROSSgS SONIC LINE 

cRxc * extension criteria for new Ol which CROsses SHOCK Wave 

CRHACHa UPPER MACH NUMBER LIMIT FOR OL BXTENSIQN 


qutput- 

SGiREFa AVS OF MIN aND AVERaGE DIST BET OLPS 


C 


STATION Table 
index- l*lo#lesta 

SCHOKEa STATION CHOKE INDICATOR ( AD JWF .'BRHS i'WR I OUT ) 

MCL a SHARP CORNER INDICATOR (BlDTBS) 

MCL * field INgEX OF control STREAMLINE (PTmOVE.FLOBAL) 

COMMON /CHDATA/ Xl U ) ,LNEXT a ) , mL 3 (1 ) iMUBiU . PR IM U ) » 


1 

1 

s 

& 


DIMENSION 

equivalence 

integer 


TYPELBa),NAMBLB(l),lLBU);FLBa>,SlLBU). 
TYPEUBm,NAMEU0(n,IUB<li,FU8a)^SiU8U», 
VMBa>iOWDV<i),X2CL<l»,SL«WfIl>,MCLa)» 
ANGTEtiliPTlEU JiPSTEU » .FGrTE U )| RGtE U » . 
AnGExPU}|BS0EXP(4T5) 

CRVLEUHiANgLEU) 

fSCHOKEfDWOV) ,(CRVLE,AN®Tg>;(ANGLB»PTTE> 
PRlM,T.yRELB,TYPEU3,SCH0KECiy 


common /SLTAB / l(i((128) |X2(128) iSLCHN|i2Bj 


integer SfcCMN 
COMMON /ALfeCoM/ 


1 

2 


real 
logical 
logical . 

COMMON /CB / 
COMMON /CBlTs / 
COMMON /CCRX / 


MACHAiPSA,TsA,PtA,TTA» AXtA?RGA,GAMA 
machc»P5c,tsc,ptc,ttc; axtc,'Rqc,gamc 
DAXIT*SBAlEA»TTE#CHOTST 
MACHA(i IiMACHC 

A^^UiAMC 

chotst 

BI300) 

BITS.BLANK 

GRXSL’j:CRXOL«CRXSSiCRxE,0RXC|CRMACH 


cOmmOn /cbdumP/ isOdmR 
common /CIDEX / MivIJMUiMD, ISTaQ 


I 

f 


common /cm / JMSI300) 

common /CMA^^IT/ MAXlTiMAJcTR.GREFINiEDUM 
LOGICAL GREFIN 

common /CPHIl / PHUI300) 

common /CPf / Rl |TWOPl,PlQ2,Pia4,ToDe«.rORAD 

common /CPRINT/ R0UM1(3)|PReFIN,PREFn2;3SdNIC,-PPUMU0) 
logical RRTdb 

common /CR / R(300> 

COMMON /CRBFlE/ «LE1,RL62|RLE3iHLB 

integer hle 

COMMON /CREFIN/ SLSlSGgti VMGl i VmG2 
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nooon oorsn 


t 

COMMON 

/csi / 

NGR,NGZ, SGR( 10) ,GR(10> , 
$1(300) 

common 

/CS2 / 

$2(300) 

COMMON 

/CTaBPR/ 

iiTab 

COMMON 

/CTOLRL/ 

TOlRL(12),Sg1R£F,TOLINR 

common 

/CVM / 

VM(300) 

common 

/cz / 

J(300) 


SGZ< 10) iGZao) 


common /erase?/ 

1 

common /IXOHIG/ 


a 


ft 

« 


CK(128) ,DELS( 128 ) ,D£LVM(l387iUSTAIl2a) ,MJ2(l23) , 
SOX(l28),SGY(l2a),RAv(i28) .ZA\/(l28) , IA(16) , IB(i6) 
LH0;LHfc, lBDO.LSDE, LTD^LTB/ LW0,LWE, LFO.LrE, 
LO,L,ESTA.LiiO.LSE.LDlJM(6> 

MO,NM| NJ.NfCOLS, MAXNj*MAXf5L,MAXNM,MAXl.6, 

IfcOiLEfc, L«0iL«e.URD 


INTEGER EXl,ri):I.D,HlNT,TE 

LOGICAL DOWNB|fcXTNUi,EXTND2iHALVE^NEW5L. SSPiUPHER 


DATA EXT ,ntLD|HlNT;Tfc/3HfcXT, 5HFIELD.3HINT, PWTE/ 


IGODMPa 4 

ghefin. , false, 

QVMGi s 1,/VMGl 
QVMG2 » 1;/VMG2 
xiNOT * -i; 

CHECK TO SEE IF PARTIAL OL ShOUUD 3E EXTENDED 

check to see if partial sl Should 3E extended 

OMIT 

EXAMINE grid increment BETWEeN ORThoGONaLS 
300 LI * LO 
NAVG a 0 
SGlAvGa 0, 

SGjM I N« 1 , E 6 
SGMX = 0, 

SGHX2 s n. 

check for adjacent stations aNd dETERmINB the base station , 

A BASE station is THE OL UrSTReAM OF LB STaG PT, 

DOWNSTREAM OF A TE, OK Tnfc SHORTEST OF (PARTIAL) OL^S, 
otherwise the base STATION CaN 8= ElTHBR THE UPSTREAM OR DoWNSTRE 
DOWNS s DOWNSTREAM BASE STATION 
305 L2 a LlaUNExT(Ll) 

lF(L2.Gfc/LESTA) GO TO V? 

MAj s ML8(L1> 

M a MAt 

CALL GETIX 
MADI 8 MD 
M8l a MUB(Ll) 

H a MBX 

CALL GETIX 
M8D1 * MD 
MA2 a MLB<L2) 

M a Ma8 

CALL GETIX 
MAU2 a MU 
M82 a MUB(L2) 

M a MBE 

call GETIX 
MBu 2 a MU 
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C ADJACENT STATION TtST 

IK ( (MA2,LE',MaD1 ;aND, MADi,UT.M32) ,0R, 

1 {MA2sLT,MBD 1 ,AND. ,ORj 

2 (MAi,LE;MaU 2 ,*AND, MAU2fLT.HBin GO TO 330 

C check FOR TE FOULOHtU BY lE 

IF(MAJCTK,GE,1) go to 55q 
IF(TYPELB(L1) .NE.TE) go to 322 
M = MAl 

GO TO 324 

322 lF(TYPEUB<Ll);N£.Tb) GO TO 550 
M s M 01 

324 call GETIX 

CALL STAXKXlfLl) ,X2(J)#X2(J),LX8,LXA) 

LXB.LXa are stations below and above The trailing euge, 

IF L2 is a LEADING EDGE STaTION FOLLOWING Ll, THEN Ll MUST 
BE the second of THE TwO TE STATIONS; 

IF(L1,E0.LXA ,0R. LI.Eq.LXB) go to 325 

325 IF(LXB.GT,L1 ,’OR. LXA.qT.LI) GO TO 590 

insert an orthogonal between the trailing edge and 
leading edge stations, 

DEFINE MJ2U ) »CR( 1 ) »NI • DQWnB,LiL3 
1 = 0 
M : M|_B(LXB) 

326 I s Ul 

MJ2< I )= M 
CR( I ) r 2, 

M s M*1 

IF(M,LE,MU0(LXB) ) GO TO 326 
M s MlP(LXA) 

327 I s Ul 

MJ2< n* M 
CR(I) s 2. 

M * M + 1 

if(m,le;mur(lxa) ) go to 327 
NI s I 
DOWNS = .FALSE, 

It S Ll 

U3 = L2 
go To 440 

c number OF primary stations 

330 NPRIM s 0 

IF( PRIM(L1 ) ,0R;PRIM(L2> ) NpRjMsi 
IF( PR1 MIl 1’;AND,PR1M<L2) > NpRlM=2 
U^ASE s Ll 

IF(NPRIM-I) 340 »3t>0#360 
C NO PRIM STATIONS 

340 IF(MAU2iGT',Mai '.OR, MBU2,lT.MBI) GO TO 38o 
GO TO 370 

C ONE PRIM STATION 

350 lF(PRIM(Lin GO TO 380 
GO ^0 370 

C both Ll and L2 ARE PRIM STaTjOnS 

360 lFnMB2-MA2) ,GT , IMBl-MAl) ) GO TO 380 

c upstream base station 
370 DOWN0 « .FALSE, 

MA X MAI 
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MB a MBl 

U * LI 

L^ a L2 

GO To 3^0 

C pOt^N^TREAM BASE STaTjoN 

3H0 powNRa ,true; 

Ma a Ma2 

MB a MB2 

L * L2 

a H 


C CHbcK L.fc. refinement CRITERIA 
390 IF(MAJC^R.ELI,0) Gt) TO 400 

IF(TYPELBIL3) .NE.HLE .ANy, T YPEUB ( L3 ) . NE , WLE ) GO TO 39S 
C NEW orthogonal in FRONT Qf L,E', 

IF(DOWNB) go to 394 
MX z MBU2 

IF(TYPEUB{L3) ,EQ,HLE) MXaMAU2-l 
S2B a S2(MX)nS2(MX-l) 

S2A a S2(MX*2)aii2(MX*l) 

M = MXt.1 

CALI GETIX 

SIB a S1(MD)-^S1(M) 

M a MD 

call GETlx 

S1R2 a Sl(MD)-SKM) 

M a MX*2 

call GE^ IX 

SlA a S1(MD)"S1(M) 

M a MD 

call GETIX 

S1a2 * S1(MD)*SKM) 

If" ( <S1 A,LE,RlE1oS2A ,0R, S1B,lE;RlEI*S2B) 

»,OR, SlA.LT, ( .2i*SlA2) , OR . SlB , pT , ( , 2«SlB2 ) 7 GO TO 550 
GO TO 400 

c NEW orthogonal behind L,E, 

394 H a MB1*'1 

lF(TYPELBtL3) ,EQ,HlE) M«MA1*1 
call GETIx 

SIA2 a Sl(MD)-SKM) 

DR a R(M)*R(MUI 

DZ a Z(M)-Z(MU) 

SlA * SQRT(DZ*DZ*DR*UR7 

IF(Sia2,LE;RLE2»S1A) go To 550 
GO TO 400 

C inhibit refinement around A FIxEd stagnation point 

395 M a MLB(L3) 

CALL GETIx 

IF( ISTAG.NE,!) GO TO 39? 

IF (DOWNB) GO TO 397 

C NEW OL IN FRONT OF STAG pT On lOWE« BDY 

S2A a S2(MAU2*1)^S2(MAU2> 

M a MAU2tl 

396 call GETIX 

SIA * Sl(MD)»Si{M) 

IF(SiA.LE.RLE 1«S3A) GO TO 5so 

GO To 400 

c new ol behind'stag PT ON loWeR boy 
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J97 

i98 


C 

399 


C 

3992 


C«* 

c 

400 


420 


423 

C 

425 

C 


C 

C 


M = MA1*1 

CALI, GETIX 

S1a 2 » Sl{M0)-Sl(M) 
pH B R{M),R(MU) 

DZ » Z(M)^Z(MU> 

SlA » S0RT(D2»DZ+DR«DR) 
1F(S1A2,LE;HLE2*S1A) liO To 550 
GO TO 400 

NE'^ ol in Front of stag pt on upper bdy 

M * MUB(L 3 ) 

call ge^ix 

1 F( ISTAG.NE,!) go Tq 400 

IF (UOWNB) go to 3992 

S2a s S2(MBU2)>rS2{MBU2-i) 

M a MBU2,1 

GO TO 396 

NEW OL BEWlNO STAG PT ON UpPER BOY 
H = MBl-i 

GO TO 398 


SWEEP across THE STReaMLINeS Tq CHECI< FOR REOD GRID REFINEMENT 
BETWEEN ORTHogONAUS Ll AND l2 
X1l3 * X1<L3> 

LX * Ll 
1 « 0 
M * Ma 
CRXL « CRXOL 
SSp * .FALSE, 

CALL GETlX 
MX s MD 
|F(D0WNU) MXoMU 
IF(Mx,EO,0) GO TO 430 

call stano(mx,lx,uum) 

If (XKLX) ;ne;xil3) go to 430 
1 * !♦! 

DbLS(I)= ABS{S1<MX),S1(M) ) 

CALC Largest, next largest distances between orthogonals, sg4x,s 
FOR determining number of extra Sl9S 
IF(MAJCTR,GE,J) go to 425 
IfidelsU } ,lt vsgmX) go To 423 

SGMX2 = SGMX 
SgmX * UELS( I ) 

GO TO 425 

IF { dels ( I ) .GE,SGMX2) SGMx2=DELS( I > 

MINIMUM distance BETWEEN ORTHqGDNAlS 
SGlMINs AMIN1{SG1MIN|QELS( 1 ) ) 

Average distance between oRthogonalS 

SGIAVG* SGlAVGtUELSt I ) 

NaVg X NaVG+1 

PELVM( I )4ABS(VM{MX)«VM(M) )»QVmG1 
RAV<I)s ,"5»<R(MX}*R(M) ) 

ZAV<1)» ;5®(Z(MX}*2(M) J 
MJ2U )s M 

CHECK FOR supersonic FLOW 
IF(8(M)iLTiO. ,0R, B{MX),lT.O.) SSP = TRUE'.* 

CHECK FOR Transonic expansion o'’ compression 
1F(B(MX)»B|M) ,GE,'0. ) GO TO 43(j 
IF(DOWNB) MXsM 
CRXLl a CRXE 
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.'G6,0, > GHXU = CRXC 
CRXU * AM1N1(CRXU1,CHXI.) 

430 M * 

IF(M,LE,MB) go TQ 420 

!F(CRXSS.lE,CRXL iAND, SSP) CRXLaCRXSS 
!F (MasJCTR.EQ.O) CRXLsO, 

Nl a ! 

CALI, LnTHCR,SGR,NGH# HA V , SG Y , > 

CALU LFlTlfGZ.SG^.NGZ, ZAV.SSX.NM 
halve * .'FALSE, 

DO 432 I*1#NI 

RS * DELS{ I )/AMAXl(SGX( I ) ,SQY< I) ) 

CH( I ) » RS ♦ DELVM(I )*RSa»,2 
432 1F(CR( I ) .'GTa, ) HALVE = ,THUE. 

C PREVENT TOO RaPIO CHANGE IN OL SPACING BY FORCING A NEW OL 
IF(HALVE) go TO 440 
X1D12 a .5*(Xia3)-XKLl) ) 
ir<PRIM(Lin GO TO 436 

IF({X1IU1)-X1(L1H)).LT,X1D12) HALVE*; TRUE? 

GO TO 437 

436 LIM a Ll 

437 IF {PRIM(L2n GO TO 438 
L2P a L2*LNEXT(L2) 

1F( (XKL2p)-X1( l 2) ) .L’f ,^1D12> HalVR* , TrUe’,’ 

GO TO 439 

438 L2P a L2 

439 IF( , NOT, HALVE) GO TO 5i0 

1F(TyPELR(H) .EQ.’FIELO ,0R, TyPel 3(U1M);E0. FIELD ,OR, 
a TYPELBa2) ,EQ, FIELD , OR , T yPeLBI L2P ) ;E0 . F I ELD) GO TO 439i 
CR(i) a 1. 

GO To 440 

4391 CH(NI )*1, 

C PREVENT Too RaPIU CHANGE IN OL SPACING BY SUPPeSSING NEW 0l*S IN 

c Early stages of refinement 

440 1F(MAjCTR.EQ, 0 iOR. MAjCTR,gE,4) GO TO 445 

C CHECK ONE POINT ONLY 

1 a Nl/2 ♦ 1 

M a MJ2< I > 

CALI GETIX 
IF(DOWNB) go TO 441 
MUl a HU 
Ml a M 
MX a MD 
M a MX 

call GETIX 
MUl * MD 
GO TO 442 
C DOV)NBaT 

441 Ml a MU 
MX a M 
MUl a Ml) 

M a Ml 

call getix 

MUl = HU 

442 DSlU a 0. 

IF(Mu1.6Q,0) go to 443 
DZ a 2(M1)-Z(MU1) 

DR a R<M1),R<MUD 
DSlU a SQRT(DZ«0Z*0R«DR) 
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443 DSlL) s 0. 
lF(Mni.tQ,0> GO TO 444 

DSlU r SUMDD-SKMX) 

444 fF(DEtSn ),GE. ( ,4«DSlU) ,4^0, D£L S ( I ) . GE , ^ . 2 «DSiD ) ) GO TO 445 
XINOT s XKl,) 

GO TO 550 

ado a NE'*' orthogonal LlNfc BfeTi^EEN LI aNq Lfi, FIRST CHECK MEMORY 

445 XlNfcW a , 5» ( X 1 ( L 1 > 1 ( L 2 ) ) 

EXTNdIs .true, 

EXTND2S .TRUE. 

1F( TyPELB(L) ,EQ.F lELD) hXTNOl= , FA lSE , 

IF(TYPEU9(L) .'EQ.F lELD) £XTND2= , FAlSE . 

IKET s 0 

IFMLESrA^20) ,LE,‘MAXLfc) GO TO BoO 
write (6, 1440) XlNEW 
GO TO 99 

450 IF(NL.E0,D go to 455 
WRITE (<>»145o) NLiXlNbW 

1450 FORMaT(/3Xi 12.1X1/H0L-S REQUESTED aTFS'.S,} 

Iti(l) X IB(NL) 

NL a 1 

C** adjust pielD A^^^A^S pOH T^^£ Ql 
455 nPTS a j B ( 1 ) - 1 A ( 1 ) 1 1 
GReFINx .true, 

call ADDFPT(MA2|NPTS, 999999) 

C CORRECT the POINTERS IN THE JMS-TASLE 
MNEW a MA2 
MA a MNEW 
I * IA(1) 

460 IFIOOWNUJ GO TO 47Q 

C (UPSTREAM BASE STATION) 

C UPSTREM POINT 

M a MJ2( I ) 

call ge^ix 

MDSAV a MD 
MO a MNEW 

call SAVIX 

C NEW POINT 

MU a M 
M a MNEW 

MD a MDSAV 
ISTAG a 0 
CALL SAVIX 

C DOWNSTREAM POINT 

M a MD 

call GETIX 

MU a MNEW 
call SAVIX 
GO TO 490 

C (DOWNSTREAM BASE STATION) 

c downstream point 

470 M a MJ2(I)+NPTS 

call GETIX 
MUSAV a MU 

HU a MNEW 

call savIx 
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C Ntw POINT 

MU * M 

M • MNEW 

MJ « MUSAy 

ISTAG * 0 

CALI- SAVIX 

c upstream point 

M s MU 

CAUI-, getix 

MU * MNEW 

CAlU SAVIX 

490 I * !♦! 

MNEW « MNEW+1 
IP(18(l)-.I) 495 i 460i460 
495 MU « MNBW,1 

C*« modify STATlOiy.TABUE 

500 CALU INSTA<t 2 .LiL'i|DOWN 8 , Ma,m 8 > 

c increment to the next okthogonal interval 

550 LIM s LI ' 

LI « L2 

GO TO 305 

c average uist bet ohthqgs 

99 SGlAVGs SG 1 AVG/FL 0 AT(NAVG) 

SGlREFs ;5«(SG1MIN*SG1AVG) 

EXAMINE grid INCREMENT A 80 VE STREANLINB J 2 ^ (J 2 »l.NJ> 

J2 « 1 

100 J 2 NEXT. J 2 *l 

1 F(W( J 2 *t) ;EQ,o; ) GO TO 200 

e NgXTRA* NO OF E^TRa Si,>S NEAR ThB BODY FQR CHN»EHT,InT 

NEXTRA* 0 

if<majctr;gt;o ,or, islchnc J 2 > ,ne'.ext -.-and; slchni j 2 | .ne.mint) > 

1 GO TO 104 

M X M 8 EGIN(J 2 ) 

DSOL * SGMX 2 / 2 , 

RROL * (R(M*|),H(Mn/OSOL 

IFUXIM RROL»(R<M* 1 >«R(m* 1 ),R(M)»R<M> J/(DSOL»|RlM)*DSOLl ) 

RR « o; 

IFIR(MJ*,LE. ,11 GO TQ IQI 

C THE first SL is TO HE PLACED ABOUT ONE BODv RADIUS AWAY 

RRATlO* R|M*1J/H<M) 

RR X HRATIQ- 1 , 

IFIAXIAI RRsIRK/.TIO«RRaT lO-i; )/3, 

101 RR * amaXiJRR,RKOi,I 

C NEXTRaA MAXO(l,MlNOUNT(ALOG<RR)/At 08 < 8 .T)-l, 8 n 

NEXTHat MaXOU, INT( ALOG(RR)/ALOOt 2 ;) n 
104 M B MBEG 1 NU 2 I 

C M X THE FIRST POINT ON THE STREAMLINE 
EXTNDIx ^TRUE, 

EXTND 2 i ;TRUE, 

L » 0 

WMIN s i;E 6 

? » 1 
no call GETIX 
MNEXT * MD 

call STANO|M,l#UPP£R) 

C bypass upper BOUNDARY OF PARTIAL OL 
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IF(UPPER) go to 120 
C CRECK t:E; REriREMENT CRITERIA 

IP( rSTAfi .NEV1> GO TO 
S2A s S8 (hU+1|"S3(mUJ 

DZ ? 

Dr * R«M+1)"8(MU*1) 

SlA » SpRT<DZ«UZ*DR»BH) 

DZ = Z«MD* 1 )-Z(M*U 

DR * R<M0*1).R(M*1) 

S1a 2 = SORT(DZiUZtDR*l)H) 

ip( (S2 A;lT,RlE3*Sia ,QR, S2A.l.T,RLE3«SlAa> ’.ANp. MAJC^HjGE.l) 
I GO TO 200 

U4 lsta< n=i, 

M 

0Et,S(H»82<M^lj»G2(H) 

C {N0Te,S2 is not updated if this is for an extra si.) 

DE|.VMn >*A0S( VM(M*1),VM<M) )«OVMg 2 
ZAv(i)i ;5ii(Z{Mti)*2<Mn 
RAV(1)« ;5«(R(M^l)*R(Mn 
M i M*3t 

CAUL GETiX 

If(I,EQ,l *,AN0, RU.NE.O) EXTNdI*. false; 

IF<MN£xT;EQ,0 ,aNO, MD.NE.oi EXTN02s.FaLSE; 

C CHECK L7E; refinement criteria 

IF(1STA6,NE,'1) GD to 117 
S28 = S2(MU>-S2(HU-i) 

DZ » ZIMo^X)«Z(M«1» 

DR s R(My,l),R(M.ll 
SIB > S9HT(DZfD2TDH«PR) 

DZ = HMO-l)-Z(M-l) 

DR a 

Sl02 a SQRT{OZtDZ«DR«[)R) 

IF( (S28;uT,RLE3tSlB ,QR, S23.LT, RLE3aSiBS) .AND. MAJCTRiGE.l) 
I GO TO 200 

117 IF(W( J) ,SE;WmIN) go to U9 
WMIN s W(U) 

X2MIN 9 X2(U) 

119 I a 1*1 

120 M a mNEXT 
IF(M,NE,0J go TQ 110 
Nl a l.| 

CAUL LFIT1(GR,SGH,NGR| RAViSGY,NI> 

Call lfitugz.sgz.ngz* zav,sgx,ni> 
c cRii)=i IS The radius of permissible grid size 
Halve « ,FaLse, 

DO 132 1*1, NI 

RS » ABStpELSn ) )/( AMAXl(SGXn ) iSGTlI ) >*SG21) 

CRM) a RS * DELVM( I )*RS««,2 
IF(CR( I ) ,GT,1. > halve*, TRUE. 

132 continue 

C**« IF HALVEaT add NEW SL F 0« STaTiOrS pOR WHICH CR.GT.5 
IF( , NOT, HALVE) GO TO 200 
IRET 9 ,1 
CRXL * CRXSl 
if(majctr;eq,’o) chxl=o, 

60 TO fiOO 

145 wNgw ■ .’SaivK j2)*wMIN) 

XI2 « .■5*(X2( J2)*X2”|N) 

C begin loop pOR jNSeRTiNq The (PaRTiaL) STRgAMLfNE, LjsijNL 
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ui * 1 

NPTADD* 0 

150 ll « IA(1,I ) 

12 m 1B(U) 

IF(U,EQ,0) GO TO 195 

c determine Jif index of new St 
J * yl2 

160 IF(W( J) ,QT,W|sjeW) GO TO 170 
J = J*1 

if(j,gt,nj) call ERRORI 

GO TO 160 
1^0 J1 « J 

C ■ ADJUST FIELD ARRAYS AND Sl TABLES 
NEWSl » ,TRUg, 

I s Tl 

MUl * 0 

• if(Nj,lt;maxnJ) go to lao 

WRITE (6,1173) XI2 
RETURN 

180 L ■ USTA(I ) 

Ml • MJ2( I )*NPTaDD*1 

MDl » 0 

call ADPTSLlMliMUl.MDli Jl.NEWSL) 

NPTADD* NPTADD*! 

M » Ml*l 

call GETIX 
JP * J 
M « Ml«l 

call GETiX 

JM s J 
M s Ml 

J s J1 
W(J) » wnew 
X 2(J) ■ Xl2 
M * Ml 

F 3 {WNEW-W( JM) )/(W( JP),W< JM> > 

DZ » M*l)-Z(M,i) 

DR * R(M*1)-R(M^1 ) 

1F(,N0T,AXIA ,0RV ABS(DR) ,LT, . 0 i*ABS(R(M.i) 1 ) Go TO 1804 
T » R{M-l)/UB 

F 3 SlGN(SORT(T«T*(TtT*l, )«F),DR) • T 

1804 ANGCHDs AT AN 3 ( DR , DZ , PH 1 1 ( M-l ) ) 
yPA 3 PHU(.M^1)-ANGCHD*PI02 
yPB * PHI1(M*1)-ANGCH0 *PIo2 
G 3 1,.F 

yODX 8 F»G*(G*YPA*F.*YP8) 

R(H) * yODX»DZ*F*DR * R(M-l) 

Z(M) 3 F»DZ,YQDX*DR ♦ Z(M-1> 

B(H) * G*8(M*l)tF*B{M*l) 

S1(M) 3 G*Sl(M-i)*F#Sl(M+i) 

VM(M) 3 6*VM(M»1)*F«VM(M*1) 

PH11(MMG*PHI1(M*1)*F»PHI1<m*1) 

C set ISTAG33 FOR PTS ADJACENT Tq L.B, AND BOUNDARY CORNER PTS, 

!F( IPRIM(L) |EQ,0) GO TO 18S 
M ^ 3 Ml"l 
call GETIX 

istagm? istag 

M a Ml*l 

Call GETIX 
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IF( ISTAGM-.tQ.l) tiO TO 18l 
JF( ISTAG.NE.i) GO TO 185 
C (JSTAGH»1) 

ISTaGM> 0 
GO TO 18? 

C (JSTAGM*!) 

181 JSTAG = 0 
call SAVIX 

132 M = Ml 

CAUL GETIX 
ISTAG = 3 

caul SAVjX 

M = Ml-1 

call Gfc’^lX 
ISTAG s istagm 
CAUL SAViX 

C UPda’^P STaTION^TabLI; POINTERS To THE FIELD-TaBUS 
185 CALL STTOFML.1) 
ghffins .true, 

C INDEX TO NEXT PT ON SL 
NEWSL * .FALSE, 

190 I s Ul 

MUl e Ml 

IP(l2-n i94,i8o»18o 

c index TO NEXT PaHTJaL i>L 

194 J2NEXT. J2NEXT^1 

195 LI * LI*1 

IF(Nl-UIJ 200,150i15C 

C LOOP TO PUT IN ADDITIONAL SL'-S FOR EXTERNAL CHANNELS 

?oo if(nextra,eo,o) go to 210 

NEXTPAs NEXTra*! 

GO To 104 

C INCREMENT THE STREAMLINE COUnTeR J2 
210 J2 * J2NEXT 

IF{J2,LT,NJ) go to 100 

c print comment if an ol was Suppressed and no other grid Refinem 
IF( .NOT.GREFIN .and, XlNOTjGE.O’.) WR I TE < 6» 17 0 0 ) XINOT 
RETURN 


evaluation of new line positions 
OUTPUT^ 

NL new LINES ARE TO BE IN ThE REGIONS IA(lIT TO IBlUP# LI*1#N', 

for ia<lm;ne,o, 

C search for CK.GT.l, POINT 
800 NL ■0 

I * 1 

805 1F(CR(I).GE,1, ) GO TO 8l0 
I » 1*1 

IFd.LEtNIV GO Tq 805 
GO TO 8^0 

C FIND lAilB SO that CR,GE,.37b IS WiThIN lA.lB 
8l0 NL s MIN0(NL*1»10> 
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ISAVE * 1 
815 lA(NL)a 1 
1 * 1 1.1 

1F(I,GE,1 '.and, ( I ,GE, ( ISaVEs3>;0^.CR{ 1 > ,6E,CRXu) ) GO TO 815 
I s isAve 
820 lb{NL)a I 
I * T*1 
IF< I .GTjNJI ) GO TO 840 
IF(CR{n,GE,i, ) ISaV£ = J 

IF { I ,LE ! MSAVE*3) .or, CN ( 1 ) , gE *, CRXL > GO TO 820 

C REPEAT the above FOR THE NEXT PARTIAL LINE 
IF(I ,LT,Nn GO TO 805 

C ADO ONLY ONE LINE IF NL,eU,l0 
840 IF(NL,Nb,lOJ GO TO 850 
NL * 1 
18(1) « IBdO) 

C eliminate the SHORT caPS BETWEEN LINES 
850 IF(NL,Lb,l) GO TO 860 
LiLASTa 1 
DO 855 LI»2.NL 

IF((IA(Ln«lB(Ll-l)),GT,7) GO To 854 
IB(LUl>alB(Ll ) 

IA(LP* 0 
GO TO 855 

854 LILASTs LI 

855 continue 

NL * LILAST 

860 IF< U(l) ,LE,2 .aNU, EXTNUl) lA<l)ai 

lFdNl«lB(NL) ) ,LE,2 .ANU, ExTND2) lB(NL)silI 

0 extend each line to a minimum of five points 

NPTS s 0 
DO 870 LIsliNL 
IF(IA<LI) .EQ.O) GO to 870 
865 lOEF « MAX0((5,tI8an»lATLl ) ) )/2, 0) 

IA(LI )s MAX0( 1 A(LI )-IUEF,l) 

IBILI )» MINOnsai >*IDEF,NI ) 

NPTS 8 NPTS ♦ IB<LI)-U(Ll )♦! 

IF(NPTSiLT,5 .and, NPTS,L7,N1> GD TO 865 

870 Continue 

IF( (NM*NRTS);LE,MAXNM) go To 89q 
write (6,i80d NMiMAXNM 

return 
c return 

890 IF(IRET) 145,450|450 

1175 F0RMAT(38H *•* STREAMLINE L^MIT REACHEP. ( X I 2*F6 , 3» 1H M 
1440 F0RMAT(73H STATION TaBlE STORaGE LIMTT DOES NOT ALLOW A N=W 0 

»RTH0G0NAU at XIlaF7,34lR,/6X6lHGRID REFINEMENT BY INSERTING OHTHOG 
aONALS IS being TERMINATED,) 

1700 F0RMAT{5lH GRID REFINEMENT OF ORTHOGONAL LINES NEAR XIiaF3;3, 

a52H WAS DELETED BEEAUSE OF LaRQE VARIATION IN SPACING, /4lH R 

aEViSED SGRiSGZ INPUT IS DESIRED, ) 

1881 F0RMaT<71H FIELD POINT STORAGE LIMIT PREVENTS FURTHER GRID RE 

ttFlNEMENT, <NMsI4,8H, M AXNM* I 4 • IH ) ) 

END 
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#P6CK RErBLK 

BLOCK data RBFBLI< 

• REF8LK BLOCK DATA FOH REFjNJE 

common /CRgF’LE/ RLE1*RL62 ,HlE3»HLE 

DATA RLEl,RLE2iRLE3/,65fX,3,1.3/, HLE/BHLE/ 

END 


•hefblkp 
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•DECK sue 

subroutine 5>LC 

• SUC*-« STHEAMUINE cuhvature etc •SUO 

C««»«CAUCUUATb angle, CURVaTURE AND ARC LENGTH ALONG STREAMLINES 

C INPUT, 

CBS 
C Z,R e 

c bRaNchs 

C 

C OUTPUT" 

C PHIl s ANGLE IN RADIANS 

c cuRV • curvature 

C SI s ARC length 


C C 0 MB 4 

c statab, CADJWF, BOVTAB, WAKETb 
c boundary table 

C index- LBsUBDOiLBUE 

C LBNEXTa INCREMENT TQ NEXT BOUNDARY 

C LBZl « INCREMENT TO THE FIRST BOUNDARY POINT (=0 BEFORE COaLLATIO 

C CHNAMEa channel WITH WHICH THE BOUNDARY DaTA IS ASSOCIATED 

C UP a T 0 « F FOR UPPER OR LQWeR BOUNDARY 

c LEDEX a relative InDEX OF L.E. POINT WrEN LOHeR AND UPPER SURFACE 

C CONTOURS ARE CONNECTED 

C 8DNAME,LBA,L8B=NAM6 AND InDEX LIMITS OF SPECIFIC BOUNDARY 

c data when boundaries are coalLated 

DIMENSION BUTd ) tLBNExTa ),LBZl(i) , 

1 chnammi),up(i),ledEx(D, 

2 ZBT( 1 ),RBT< 1 ),AnGBTC 42 ) 

logical up 

INTEGER BDT.CHNAME.BDNAME 

DIMENSION BDNAME(X) , L B A ( 1 j , lBB (J ) 

equivalence tBDNAMEfZBT ) , (l 8 A,RbT)» (LBB.ANGBT) 

C FLOW adjustment TABLE 

C index* LFaLFO.LFE 

C NFcOLSa 8 

C XIF s orthogonal COORDINATE 

C X 2 F a streamline COORDINATE OF SL EMINATING FROM T,E, 

C XIBF a XlfCoORDiNATE OF CHqKE STATION OF FLOW BELOW T|E, 

C XIAF a X 1 *CooRDINATE OF CHoKE STaTIqN OF FLOW ABOVE T,£, 

C Sir 3 SI.COORDINATE of T,E, (upper surface).' this item 

c IS USED WHEN INTERPOLATING FqR WAIi(E DELTA-STAR, 

C LFB,LFa=INDICES of stations below and above t.-e, 
c NCHB,NCHa*NUMBER of channels BElOW and above t,e, 
c LRF 8 index of dummy ortchn list For the t,e, 

C LRXF S index of last channel below the t';e^ 

C ■ JORDERs 0 IF total FLOW AT XlF IS GIVEN 

C a 2 IF FLOW ABOVE T.E, IS GIVEN 

C s 1 IF FLOW below T,E, IS GlyEN 

C JORDERs *1 IF FLOW aT XjF IS cMOKEd AND SINGLE CHANNEL 

dimension X 1 F( 1 )iX 2 F< 1 ) ,Xi 8 F(l>,XlAF(l), 

1 SlF(l) ,NChB( 1 )iNCHA< 1 ) , JOfiDBRaJi VNR( 12 I 

equivalence (UFB.XIBF), (UFA, XIAF), (LRF, NCHB), (LRXF, NCHA) 

dimension LF 8 ( 1 ) ,LFA( 1 ),LRF( 1 ),LRXFUT 

c station table 

C index- LaLdiLESTA 

C SCHOKEs station CHOKE INDICaTqR ( ADUWF ,BRHS ,WR 1 OUT ) 

c MCL s sharp corner indicator (BLDTbS) 
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streamline coordinates 

nominal upstream streamline angle for USE IN Selecting 
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C MCL 8 FIEUD INBfcX OF COnTrOl STREAmlINF ( PTHOVE # F LOBAl, ) 

COMMON /CHCATA/ X J. ( 1 ) j UNtX T ( 1 ) , ML 3 ( 1 ) j HUB I • PR I H H ) » 

1 TYPEl,Ba) iNAMELBd) » ILB<1) »FL3(1) iSl,UBd). 

1 TYPEUB(l) .NAMEUBd) I lUB(l) .PURU) iSlUBd) , 

VMBlDiOWDVd) »x2Cl< 1) .3LSWI (DiMCutU i 
ANGTe(J.),PTTE( 1) ,PSTE<l».rGRTE<i)«PGTE(l), 
ANGEXP(L) ,BSQEXP<475) 

DIMENSION CKVUE<1>»ANGLE<1) 

EOUIVALENCE fSCH0KE,0WDv>. ( CRVLE , ANGTE ),( ANGLE , PTTfc ) 

integer PWlM,TYPELB,TYPEU3,SCH0KEd)' 

KE table 

DIMENSION) X2Wtl)*LWNEXT(i) ,SiW<i) ,DST{i> 

equivalence <I)ST,SiW> 

equivalence (SDT.Xif |X2W,X1) , (L3NEXT.X2F,LWNEXT,LNEXT) 
equivalence (LB^1,X1BF,S1M.mL8> 
equivalence (GHNAME|X1AF,MuB). (UPiSlFvPRlM) 

EOUIVALENCE ( LEDEX i NCHB » T YPElB ) , ( ZBT . ijCHA , N AMELB ) 

equivalence (RBT, JOHDER, ILB) , (ANGBT,VnR,FLB> 

COMMON /BENUIN/ NbCIN(2) , A0F(2> 

COMMON /CB / 0(300) 

COMMON /CREAM / UBE AM ( 3 ) , 1 OR DEP 

COMMON /CBGAM2/ OK , DZ i YP A , YPB , F , G , Dx , YODX , ZM , RM i ANGM* OURVM . Si M , 

RZONLYi AnGCHD»SI NTVL i VP ASQ ‘ YP A8< YpBSQ 

logical rzonly 

common /CBEND / NtiCB(2)tF 8(2) 

COMMON /CBITS / BJTS, BLANK 
COMMON /CBDYPT/ ANGD.CURVD 
common /CCURV / CU«V(300) 

COMMON /CFB / L#MA.MB,J2i I A, iBi I ,LTSL 

common /CFB2 / PASSl 

LOGICAL PASSl . 

COMMON /CIDEX / M , J jMU , MD , I ST AG 

common /cinner/ INRcTR 

COMMON /CM / JMS(300) 

common /CMaXiT/ MAXReF , NR£F I N 
COMMON /CPHIl / PHI1(300) 

COMMON /CPi / PI,TW0PI,PIQ2 ,Pi04,T0DEG,T0RA0 

COMMON /CPRINT/ PUUMX ( ^ ) » P DyM ( 20 ) 

CPmMOn /CPTMOV/ VElPOTj ICOBjNODENS.FbASTQ 
COMMON /CQIPEM/ VTOti YO iOYDXiCTRMAX 
COMMON /CR / R(300> 

COMMON /CSl / Sl{300) 

C^MMOn /cS2 / S2<3qoI 

COMMON /CSLC / 8RANCHI4) 

COMMON /CSS / SSFmLiSSEF.SSeanG.SSdF.SSfEND.SSFNOI 

,SSDLEiA4FaCT,BRLX|CURRlX;tSIC 
INTEGER SSFML 

LOGICAL SSEF. SSDF, SSDLE 

common /CTABPR/ IITAB 
common /CZ / Z(300) 

common /ERaSe 2/ RBU28) ,ZBd28) , ANGd2B) *'cURVB(128) ,S1B<128) , 

Bl <128)» J200NE<l28)»MSVU28r,CURSS(6)«OV{8) 
COMMON /IXORIG/ LHO.LHE, LBqO.LBDE, LTQ^LTE,’ LWO.LWE# LFO.LFE, 

LO,leSTA,lSO,lSEiL0UM(6F« 

MU,NM| NU.NFCOLS, maxnj;maxql,maxnm,maxle, 
LE0»LEL» L«0*lR£»LRD 

COMMON /SlTab / W(128) |X2(128) ,SuCHN(128) 

integer SLCHN 

LOGICAL ALLJ2iANYJ 2, JaPREVvPARSLA . UPPER 

INTEGER Tfc 
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DATA UE»TE/2hl£»2HTE/ 

0|-TSO(PTOS)=2,*FQ«X»PTUS**fgTX , 3X 

PM(bSQ)=SQRT(RX)#ATAN(SQRT(BSQ/6X)) . aT AM ( SORT ( BSU ) ) 

first PAi»S ACROSS STREAMLINES. SKI? ThOSB SL»S WHICH TeKMINATE WiTh 
IN THE Meld if 42PREV*T, at EnD of pass ALLJ2*T if all STREAMLI 
have been pitted and ANYJ2=T ff ONE OR MORE Su»S HAVE bEEN FITTED. 
C J2PREV»F IF ON THE PREVIOUS PaSS NO SLkS WERE FITTED BECAUSE END 
c condition interpolation heouirements could NOT BE Satisfied. 

IGODMPs 5 
ANYJ2 * .true, 

if (PDUM<ir,GT,0, 1 WRITE(6,1 i59) 
call SETmUiO. vJ2U0NE.NJ) 

RZONLYs .FALSEi 

C BEGIN LOOP through FIRST TO LAST STREAMLINE. J2*1.NJ 
C CALL M0EG1N TO OBTAIN FIELD INDEX OF FIRST PT ON SL 

100 J2PREVS ANYJ2 
ANYJ2 « .FALSE, 

ALLJ2 * .true. 

J2 a 1 

101 1F( J2D0NE( J2) .EO,l) GO TO l87 

M a MBBGJN(U2) 

1F(PDUM(d;GT,0, ) WRITE (6ill60) J2 

c build zb.rb.ang arrays for The streamlinb segment 
r istag*3 is a boundary of a Partial orthogonau. such points 
c ‘ are to be bypassed ano then Filled in by interpolation 
115 1 a 1 

SIBCD* 0, 

120 lA a I 
MA a M 

121 CALL GETIx 

IF (ISTaG.EQ, 3) GO TO 128 

r 8( I ) a R(M) 

ZBf I ) a Z(M) 

ANG( I )a PHII(M) 

BI ( I ) • B(M) 

MSV< I ) a M 

IF( ISTaU.EO.I ,0R, ISTaG.EQ.Z) go to 130 
124 1F<MD) 126,130.126 
126 I a I*l 

IB a I 

128 M a MD 

Mb a M 
GO TO I2l 

C SET END CONDITIONS 
130 NBC0(1)«O 
NBC8(2>aO 
FB(1) a 0, 

FB<2> a 0. 

L *0 
MDSV a MD 
ISTAGBa ISTAG 

c paRSlab Partial streamline aT end a. t or f 

PARSLAa .false, 

c ltsl ■ trailing streamline Indicator; stataB index 

LTSU a 0 
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IfcND • 1 
MX = MA 

H'( !a,EQ;i) go to 1304 
M s MA 
CAU GETIX 

f F( ISTAG,EQ,2) GQ TO 1318 
1302 lEND s 2 
MX s mb 

IF (MDSV.NEiO) GO TO l3^ 

C USE AVG CURVATUHfc B,C, FQM Pa«ITAL SL*S 

1304 CALL STANO(MX,UiUPPER) 

1F(MX,EU.MLB(L) ,'OR. upper .or, 

* 1,,EQ|1.0 »OR, <U*UNEXT(e)),gE;lESTA) go to 1346 

M = Muea) 

CAUL GETIX 

1F(MU,EQ,0 •0Ri MU,EQiO> go To i346 
C partial SLi search for nOn-TERMINATING adjacent SL 

SUM =0, 

CURVX = 0, 

M S MX 

MCHNG a ,1 

1306 M * M*MCHNG 

CALL GETIX 

IF(MU;EQ.0 i'OR. Mp,£Q,o) Go TO 1306 
ir< J2 DOnE( J) ,60.0 ,AnU. J2PREV> go to tfl6 
IF(1NRCTR,N6,0) go To i308 
IF« J2D0NE( J) ,EQ,0) go TO 1306 
13q8 IF<M,LT,ML0(L) .or, MiGT.MuB(L>) GO TO 13l0 

SUM a SUMtl, 

CUHVX a CURVX* ,5 »CURV(m> 

1310 IF{MCHNG,EQ,1) go to 1314 

M a MX 

MCHNG a 1 

GO TO 1306 

1314 CURVX a CUHVX/SUM 

NBCBtlENP)*? 

FB( lENO jsCURVX 
IFdENU.EQ.l) paK8la=,true; 

GO TO 1346 

C UPSTREAM end OF TRAILING Sl 

1318 IF(NREFIN*1NRCTR„2) 1302 » 13i9 , 131 9 

1319 call STANO(M,Ui MPPER) 

iFlTYPELBtU.NE'.TE ,AnP. T YrEuB ( L > • NE . T5 I GO TO 1302 
CAUL STAXI(XKL) ,X2( J) ,X2( J) ,lXBiLXA) 

BSQExP(L)aBlTS 
LR a LmO 

1320 1F(LW,Q£,LWE) GQ TO 1328 
lF(X2WaW) ,EQ,X2tJ2> ) GO TO 1324 
GO TO 1320 

C DSTtLSTRJaTjE, PLUS B,Li THiCkNESS 
1324 LSTRsLH*<LWNEXT(LW)-2)/2 

IF {OST(LSTR) ) 1326,1326,1326 
1326 IF(UPPER) GO TO 1332 
GO To 1340 
c sharp tve; 

1328 BSOEXP(LIii?l. 

IF(PTTE(LXA),PTTE(LXB) ) 1332,1336,1340 
1332 ANGEXP(L)*ANGT£TLXB) 

IF(LXB.NE.L) 8SQEXP(L)?"1. 

UTSL a LXB 
LSaV a LXA 
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GO TO 1342 

1336 ANGtXPa)s,t>«( ANGTE(LXtn*ANGTE<L^A> > 

GO TO 1342 

1340 ANGEXP<t- )*ANGT£(LXA) 

If'O^.NEjUXA) BSQEXP(L)»<»1, 
lTSi, 3 lxa 
LSAV s LXB 

1342 I>^(PDUM(4)w 2. ) 1348 , 1344 , i344 
1344 N8Cb(l)'l 

FB(1) s ANGfcxP(U) 

GO To 1348 

C ^ItLD boundaries 

1346 NBCB( IEND)sN8ClNfI£ND) 

FB( IENDJ*ACKnEND) 

1348 IF ( lENO,EO;i) GO TO 1302 

C define ANGU) to obtain correct asigue branch 

135 IF(JA.NE.I) go to 136 
ANG<D* BRANCHd) 

IF(BRANCHd) ,NE,999. ) GQ TO l36 

U = 0 

M = MSV<1' 

CAU STaN0<M,1,, UPPER) 

1F(M,NE,MUB(L) ) GO TO 1352 
C FIRST streamline 

LB = LBF(NAMELB{L) ) 

lb = LB^LBZKLB) 

ANGd)« ANGBT(LB) 

GO 70 136 

C NOT FIRST STREAMLINE 

1352 M ■ M«1 

IMM,LT,MLB<L) ) CALL EHRORl 

call getix 

iFi J2D0NE( J) ,EQ,0) GO TO l3s2 
ANGd)e PHll(M) 

IF (PDUMd9) ,EO,li I WRITE ( 6 , 1 353 ) J , H , AnG ( 1 ) 

1353 format (8H J , M , ANG , 2 I 6 , FI 0 , 6 ) 

136 IFdSTAGB,NE,l> GO TO 155 

iHfc streamline is terminated 3t a stagnation point 

PROCEED TO extrapolate FOR ps POSITION IF STaG*1 
AND boundary TYPE=LE, 

C find The stagnation point STaTiON 
L s 0 

call STano(MB,L|OPPER) 

C CHECK FOR leading EDGE POInT 
CURVD s .0 , 

IF(UPPER) GO TO 138 
IF (TVPELBIL) .NE.LE) GO TO l55 
GO TO 14CI 

138 1F(TYPEUB<L» .NE.LE) GO TO 155 

C BEGIN iteration FQR STAGNATION POSITION 
140 QV(1) c o; 

SHOVE * o; 

M * MB 

IF(ABS(PDUM(5) ) ,LT,5, ) FB(2)ai, 

145 IF(UPPER) GO TO 147 
NAMES * NAM6LB(L> 
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!BS * ILBtU) 

Fs s ruea) 
sis « S1LB(L) 

GO TO 148 

147 NAMES * NAMEUB(U 
IBS * IUB<D 

FS s FubCL) 

SIS ■ S1UB(L> 

148 CAUL. BDYPTM(naMES, IBS|ZB( I ) ,RB( I ) iFS,SlS,SMnVE,GETASK) 
1F(GETASK.EO,0, ) GO TO 1482 

WRITE (6,1148) J2iZB( I ),RB( I ) 

CALU ERRQRl 
1482 Z(M) ■ 2B( I ) 

R<M > B RBM ) 

IRET a n 
GO TO li^Sl 

C (LOGIC FOR leading STAGNATION POINT ONLY) 

149 ERRANGa AN6( I ) *( ANGO.P J02 ) 

IF(PdUM(1) ;LE,0, ) GO TQ 150 

WRITE (6,1149) QV(l),SM0VEiERRANG,Z3(I),RBn>,ANG0,CURVD 
1149 F0RMAT(14H STAG PT • QVa F5 , 0 i 2X , 6 HS'^OVE* Fl 0 . 5 , 2X , 7HBRRANGa FiO , 6 , 2 X 
*i3hZD = F10.5i2Xi3HRD*F10,5,2xi5HaNGD = F1C; 3»2x.6RClJRVD = nO,6) 

GO TO iBOl 

150 IF(CURVO,GE,0. ) QO TO 1301 

WRITE (6,il5o) Z8 ( I ) ,RB( I ).ANgD,CJRVD 

1501 IF(PaSSI) GO TO 156 

IF(OV(l) ,NE,0, ) GG TO 151 
YO a 0, 

YTOL « l.E-5 

DYDX » ABS(CURVD) ♦ 1 , / ( Sl8 ( I ) -SIB ( I *1 ») 

XJP a -A8S(ERRANG)/UY0X 
DYDX a 0. 

151 call QlBEM(SMOV£,ERRANGr XJp,QV) 

IF(aV(l» ,NE,0. J go to 145 
IF(UPPER) GO TO 132 

ILB(L)a IBS 
FLB(L)a FS 
S1LB(L)=S1S 
GO TO 156 

152 IUB(L)s IBS 
FUB(L)a FS 
SlUB(L)aSiS 
GO TO 156 

C USE ^SUBSONIC) BEAM FORMULA TO CALC AnG , CUr V aTURE , SI 
C SET lORDERal TO CHECK FOR PqInT ORDERING 

155 IReT a 1 
, 1551 NORDERa 1 
1552 lORDERa 1 

CALL BFACS(Zb,RB, ANG, CURVb»S1b, IA,IB) 

IF( IORDER.EQ.O) go TO 1555 
I a IORDER-1 

WRITE <6*1155) ZB(I),RB(l)iZB(Ul),RB(I*l).J2,IiIORDER 

if(norder,ge,’5) call ERRORI 

SAV, a ZB(I) 

ZB( h a ZB( Ul) 

ZB( I*1)=SAV 
SAV a RB(I) 

RB( I ) » RB( !♦!) 
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RB{ l*l)=SAV 
NORDERs NORDER*! 

GO TO 1552 

1555 IF(IRET) 1356 . 1 49 i 1556 

1556 1F(SSFMI,,EQ, (-1) ) CALL BF3 < Z9 , RS , ANG, CURV^ , Ia»IB» 

156 JF{SSEF .AND. , NOT , PAKS^A ) ANG f I ) sSSEAnS»TORAD 

c reuocate answers into field storage 

160 M a MA 

I s IAsI 

L * 0 

161 CALI GETIX 

IF ( ISTAG,EQi3) go to 166 
1 » !♦! 

C SUPERSONIC POINT CURVATURE 

IF(B(M) ;GE.0. ,0R. l.EQ.l) GO TO 163 
IlSS z Ui-I AbS(SSFML) 

NBCBd JsO 
NBCB(2i*0 
FB<D » ssfndi 
FB( 2) e SSFENQ 

iFi iiss;gt,i) go to 1622 
IlSS e 1 
NBCB(l)f2 
FR(D z 0, 

C LOGIC FOR FIRST PT DOWnSTRM OF T.E; 

1622 IF( (UIA) ,NE,1 ,0R, LTSL.EQ.O) QO TO 1IS29 

FGRX * FGRTEaTSL) 

FGTX s 1,/(FGRX*1,) 

GX 9 FGRX*FGRX*1| 

BETSTEs BETSaiPTTE(LTSL)/PSTE(uTSL) ) 
jF(BBTSTE,LE,q, ) GO TO 1629 
PMTE « PM(BETSTE) 

PEXP * PTT6(|„SAV) 

C CHECK FOR T ,’E , BUUNTnESS 

IF(LW.GE,LWE) GO TO 1624 
IF(DSTtLSTR) ,GT ,0. ) PtXP = PST£ ( LSAV ) 

1624 BSQEXP(LTSL)=BfcTSQ(PTTE(LlSL)/PE^P) 

IF(BSQeXPaTSL) ILfc.O, ) GO To 1629 

DELPM z pmibsqexpiltsu ) pmte 
ANGEXP(LTSL) 3 ANGTE(LTSl>*DELPM 
IF(lTSL;EO,LXA) ANGEXP(LTSl)sAMGTFJLTSl>-DELPH 
IF (P0UM(4)^1, J 1629|1626,1626 


1626 

FBII) . 

AnGEXPILTSL) 


NBCB(l) 

=1 


IlSS * 

U1 

1629 

NISS * 

I,IlSS*i 


CALL BFAC(ZB( IlSS), KB ( IlSS), ANG( IlSS >, CURBS, N I SS) 
PHI1<M)?ANG( I ) 

CURVCm)«CURSSXniSS) 

GO TO 164 
163 PH11(M)sANG( I ) 

CUrV(m)3CURVb( 1 ) 

Z(M) ■ ZBII ) 

B(m) s RRil) 

IF(I,NE,IA ,0R. I, £0,1) GO TO 164 
PHI1(M) = ,5«(ANG< D^ANGSaV) 

call 8F3(ZB( I-1),RB( I»1),ANG( I"1),CURV(M-1),‘1,3) 

IF( ISTA^.'NE,!) Go to 164 
call STANO(M,l, UPPER) 

1F(TyPELB(L) ,NE,Lt ,aNU, TYPEu8 {L) .NE.LE) GO TO 164 
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ANGLEd,)sANGD«PJQ2 
CHVLEa)»CUHVD 
164 S1(M> « SlBU) 

GO TO 168 

C interpolate curvature and location EOR 1STAGS3 POINTS 

166 dr ■ RB( Ul)»RB( I ) 

DZ » zBi UD-zau ) 

CHD « SQRT(DRftDR+DZ*pZ) 

CS « DZ/CHD 

SN X dR/CHD 

ACHD 8 ATAN3(DR,OZ, ANG( I ) ) 

P » (CS*fZ(M)-ZB( I ) > ♦ SN*(R(M)-RB( I) } >/CHD 

IF(F,GT,1. ,OR, F.LT.O,) cALL ERRORI 

G * 1,»E 

YPA s ANG(I)»ACHD 

YPb « ANG( Nl) xACHD 

call bfi 

R<H) » RB( I )*RN 

Z(M) a ZB( I )*ZM 

PHU(M)=ACHU*ANGM 
CURV(M»=CURVM 
S1(M) a SlB( n*siM 
C 168 IF( I ,GE, IB) GO TO 170 

168 IF(PDUM<1J ;LE,0, ) GO TO 16^0 
IF<PDUM(U JEO.I, ) GO TO I6fl0 
IF(PDUM<1 J .EQ.2; ,'AnD, BHp.LTiOi) GO TO l680 
IF(PDUM(U ;EQ,4; .and, ISTAg.nE’,0) Go to 1680 
XJ2 X J2 

|F(PDUM(i) ;GE,5; ,AND, X J 2 , GE , PQU'i ( 8 ) ’.AND, PDUM ( ; ) , GE , X J 2 > 

* GO TO 1680 
GO TO l69o 

1680 WRiTe(6»1161) I ,M, | ST AG*Z ( M ) , R( m ) , pH 1 1 ( M ) » CUR V ( M ) , CURVB ( I ) , B ( M ) 

1159 FORMAT(lHl) 

1160 format (12W I M lSTAGr5XilHZi9X,lHR,4X,4HPHIl,4X,4HCURV.3x. 

* 5HCURVB,9XilHB,5H J»»I3) 

1161 FORMAT <1X, 13, 14, I2;2F10,5,F3,4,2F8,5,F10';3) 

1690 IF( I ,GE , IB) GO TO 170 

M a MD 
GO TO 161 

C INDE^ TO NE^T streamline SEGMEnT 
170 IF(MD) 172i 10O»172 
172 lA = IB 

MA a M 

C 1 C 1b 

ANQSAV^ ANG(I) 

CurSAvs CuRVB(I) 

e (Transfer to i26 rather than 120 since ist point, i?ia3IB, is save 

GO TO 126 

C streamline J2 has been curve-fitted, index J2 to next sl, 

180 J2D0NE(U2)sl 
t ANYJ2 a .TRUE, 

GO TO 187 

C END condition INTERPOLATION NOT »OSSIbLEv BYPASS THIS SL 

186 ALLJ2 8 .false, 

187 j 2 8 J2*l 

IF(J2,LE.NJ) go TO 101 

C GO BACK FOR 2ND, 3RD PASS TO INTERPOLATE FOR CURVATURE AT PARTIAL S 
IF ( ,NOT, AlLJ2) GQ to 100 
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C SI-COORDINATE on top of T.e, in /ADJWf/ FOe «AKE THiBKNbSS (TlPT) 

LF » uro 

301 lF(l.r,GE,LFt:) GO TO 402 

IF<JORDtR(Uf'),UTV0) GO TO 320 

calc STAXi(XiF(LP)#ii1.iX2F<uP)»DUH,LXA) 

M ■ MLB(LXA) 

S1F{LF)=SUM) 

320 LF s LF*N^C0L5 

GO TO 301 

c modify wake Table for proper lengtm 

402 IF(NREFIN*INRCTR| 404|?00,4o4 

404 LF 9 LFO 

406 IF(LF,QE;lFE) GO TO 900 
LW 3 LWO 

410 IF(LW,GE;L«fc) 00 TO 430 

IF(X2W(LWJ ;EQ.X2F(LF) ) GO To 420 
UW 3 LWALWNEXT(LW) 

GO TO 410 

420 IF(LWNEXT(LW) ,NE,8) GO TO 430 

call STAxiIXiF(LF),X2F(LF)#X2F(LF),LXB.LXA) 

1F(NREFIN*1NRCTR"2) 422i424,424 

422 BOT 8 AN6TE(LXB).ANGT8aXA) 

F » 1. 

GO TO 426 

424 IF(PDUM(3J) 425|422|425 

429 BOr * ANGEXP(LXB)«ANQ6XP(LXA) 

F 8 PDUM(3) 

426 WLEN 8 2,*<DST(LW*3)-DST(UW35))/AMAxiO0T.a) 

S1W(LW*2)8F8WLEN * <1i3F)«SiW(LW*2) 

SlW(LW*l}»;9#SlWfLW*2) 

430 LF ■ LF*NFC0LS 
GO TO 406 

’00 RZ0NLY8 .true, 
return 

1148 FORMAT(fO«** IT|RAT10N F0« STAG FT LOCATION (Jb»I3,»)^ ORThOGONAL 
♦iTy COND requires PT TO MO’E OFF THE BOUNfeARY.P/ 

*• present location is ZsPFlO.S,^ R8PF10,5,P (SLC)*) 

1150 F0RMAT(35H NEGATIVE LtE, CURVATURE* Z*F10 , 5, 3X » 2HRmF 1 0 , 5 . 3 

*X|4HANG=riO,3,3X,5HCURV«Fi2,6) 

1155 F0RMAT(29H SLC IS INTERCHANGING PTSiFll^S, IN, FIO, 9i 6H ANO.Fi 

♦1.9ilH,FlOi5,4H J8I3|5H, Is2l3) 

end 
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«DtC*< SPc 

subroutine SPC 

«SPC^-- SONIC POINT curvature »SPC» 

c station TaBCE 

c index* LeLOiUESTA 

C SCHOKEs station choke indicator ( ADJWF.BRmSiWRIOUT) 
c MCL s sharp corner indicator (BuD^BS) 

c MCL » FIELD INDEX OF COnTrOl STReAMLIN" ( pTmOVE i FlOBAL ) 

common /CHDATA/ Xm>iLNExT(l),ML9(l)|MUBaJiPRlMU), 

1 TYPELBdJ.NAMELaa), ILBdi .FLB(1)|S1LB(1), 

I TYPEUB(1),NaMEUB( 1), IU8(1) ,FU9(l),SiU8(l», 

& VMB{l),DWDVm,X2CL<l),SLSWI {1),MCL<1>» 

8 ANGTEU) ,PTtE( 1) ,!»sTE(i) .FGRTEU) (RGTEII), 

i ANGEXP(1),BsOEXP(475) 

DIMENSION CHVLEU) , aNgLEU) 

equivalence (SCHOKE»DwDv1,<CRVlE,ANGTE),(ANGLEiPTTE> 

integer prim, TyPEL8,TyPEU3,SCH0KEUI 

COMMON /CB / 0(300) 

COMMON /CCUKV / CUR\/( 300 ) 

COMMON /ClOEx / M,U>MU,MD^ ISTaS 

common /cmaxit/ maxit,majctr,gRefin,tl 

COMMON /CR / R(300) 

COMMON /CS2 t S2(300) 

COMMON /CSS / SbTML,SSEFiSSEANG,SSDF,SSFEND,SSFNUl,, 

8 0SS(4) , TSiC.RmOC.RhOCSS 

integer ssfml 

logical SSEFi SSDF 

COMMON /CVM / VM(300» 

COMMON /CZ / ZI300) 

COMMON ,/lXORlG/ LHO.LHE, lBDO.LBDE, LT0#LTE,' lWO.LREi LFO.LFE, 

• LO,LESTA,lS0,lSEiLD0M(6>, 

• MO.NM, NJ,NfC0LS, MAXNJ*MAX0L,MAXNM,MAXLE, 

• tfcO,LtE» lROiLREiuRD 

common /SLTAB / W(128>*X2(128) iSLCHNf J2®> 

integer 5lCHN 

data BELOW/ShbELQR/, ABOVE/SHABOVg/ 

C BEGIN LOOP ThRoOGH STaTiqnS 
U * LO 

C CONVERT stag PT FROM SOP T JO HaRD (I,Ei SET ADJACENT ISTaG To 3) 

c when stag velocity is less Than haCf adjacent velocity,, 

20 M s MLB(L) 

MINC * 1 
SIDE ■ ABOVE 
22 CALI GETIX 

IF(ISTAG-iJ 36#24i36 
24 IF(MAJCTR) 26,36,26 
26 MSV ® M 

M ■ M*MINC 

CALL GETIX 

IF(ISTAQ«3> 28,36i28 
28 lFIVM(MSv)»i5*VMlM) ) 30,35»35 
30 VM(MSV)s Oi 
ISTAG s 3 

call SAVIx 

WRJT6 (6,1034) SIUEn(MSV) iRCmSV) 

GO TO 36 
35 M ■ MSV 
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36 !F(MINC) 38i37|31 

37 mA a H 


H • MU8(L) 

M I NP 9 n 1 
SIDE ■ BEl^OW 
GO To 22 
38 mb s M 

C recompute near sonic PT curvatures BT LIMEIR iMTERROtATlON 
C locate sonic POINT 

3q IF<TSICiEQ’,o;' iORi SLSWUD.EQiO. ) Go TO |4Q 
M * MA*1 

60 |F( )VGE,0, » GO TO 65 

caul getix 

1F(W( ,NE;0,') go to 70 

65 M ■ 

1F{M,GT,HBJ go to 140 
GO TO 60 

CP* fractional DISTANCE TO SONIC LINE ABOVE PT (M»l) 

70 F ■ BtN-l)/(B<M,l)«0(M) ) 

C calculation • INTERPOLATION JUNCTURE POINTS 

DFX « AM|Nl(TSlC,AMlNl<FLOAT(M-l*MA»*R;f:LOAT(MB«M*l>«FM 

FXl ■ F-DFX 

FX2 • F*pFX 

MXl a M 

MX2 B H 

80 if(fxi.qb;o, .or; (mxi-d ,le,ma> go to 9o 

MXl ■ MXfl 

FXl ? FXIAI, 

GO TO 80 

90 1F(FX2,LE'.1i ,0R; MX2iG8iMBj go to 100 
MX2 9 MX?*1 

FX2 ■ FX8-1, 

GO TO 90 

100 SXl 9 S2{MXl»l)*FXl«<S2(MXl)BS2<MXl»l>y 

SX2 * S2fMX2**tJ*FX2*<82<Mx2)BS2<MX25in 

C CALCULATE linear VARIATION Op CURVATURE BET JUNCTURE PTS 
CXI 9 CURV(MXl.i)*FXlf(CURV(MXn»CURV(MXl-lJ> 

CX2 9 CURVtMK2«l)4FX2«{CURV{Mx2).CuRV(MK2«tn 

MX ■ MXl 

120 IF(MX,QEVMX2) GO TO 65 

CURV<MX)«tCXi«(SX2-S2IM|})*CX2«(S2(MX)-3Xl)T/(SX2»SXl> 

MX » HX*1 

GO To 120 

C INDEX TO THI NEXT STATION 

140 L « L*LNexTUI 

IF(L,LT,LE8Ta) G0 T0 20 

Return 

1034 F0RMAT<26X,“24HISTAG?3 POINT INSERTED ;A5»18H L,E? OR CORNER AT? 

A 2m, 5) 

END 
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•D.5CK_ST±0fl ^ : 

subroutine STTOn {Li.MDl) 

»S TTOri adjust the STAT ION^TaBlE PQ^NTBR^ »STTQrf > 

C TO THE KIEL'D»TABlE UpWARO BV mFi 

c Input- “ “ ' 

C Ll » first station for WmICH pointers MURCL) .’MLB(L) must it A 

c Rdi s increment' to'bE adBbd To M[r0tt‘) ,, aSd mjB(L)T 

C MUa<L> .NLB(li) point TO THE FI FLnZTABu’E 


C stati on TarL E 

C ' INpEX- U*LOiLESTA 

C _ SCHO K Eg S T ATTON-CHOKE INQICaT OR ( AD Jhf7bR6s; WR I OUT ) 

C ’ " MCL * SHARP CORNER INDICATOR (BLDTrS) 

C MCL g FIELD INDEX OF COnTrOl STREAmLiNF ( PTMOVEi'FLOBAL ) 

COMMON /CHDATA/ XI ( t ) , LNEXT < 1 ) , MLI ( 1 ) fMUR^l? ,'pR TM U J , 

_i T YPELBU ) VN AMELB ( { ) i T Lr< 4 ) .PLB ( 1 ) ^ SlLB ( 1 ) 7 _ 

1 TYPEUB(l) ;NaMEU 8(1). IUR<li , PlJB ( 1 ) * SlUB ( 1 ) . 

_ VMb<1)i:DWDV( 1)«X20L (l>7Si‘ftN|(i) ;MGL(l) i 

« ANHTEU) .PTtE( 1) »PSTF<1 ) .efiRTj^ID^RGTEd) . 

__J ANGEXPU)»BsQEXP(47S‘^ 

DIMENSION CRVdE( i) » ANQLE(i) 

EQU I VALENCE fSCUOKE.DWDv ) , < CR VI'EVanGT^: ') V ( ANGLE • PTTE )' 

INTI G ER PRTH ; TYR^ LBVTYPEUB’;ScHhKF a i ^ : 

C O M M_o (i / T_x oRig/ LHOfLHE; LRDO.'LaDEV i.'Tnri’Ir: lho.'l h e, l f o ;lfe. 

K LO.LESTA, LSO.’LSE, LDO'.’Lnt:. LDUN(4>r 

& MQ.NM.Nj^NFcqLS; fAXNLiVMA^Ol:’; MaXNM/MAXle; 

& LEOiLEEf iROtLREiLRD 

COMMON /cniTs f BITSiBL ANK ^ 

L _ = Ll 

m6 s moi 

MUB(l.)g MUB(L)-»MB 

IF( (MUB(L)»ML8<Ln .LT.M aXoL) GO TO 60 

caLl errqri 

■p L » L+LNEXT(L) 

IFIlIgE.LeS Ta) go to 900 

MLB(D* MLB(L)*M0 

MUBCpg MUB(L)»HD 

GO To 60 

900 RgtURN 

.. £ND 
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•DECK STCM 

0VEHLAY(STC.4»0) 

PROGRAM STCM 

common /CPRINT/ PPDUM(6) ,PdUM(20) 

CALU MCOEF 

CAUL IAD 

RETURN 

END 
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•DECK USECDM 

BLOCK data USECOH 

•USECOH REPLACE STQM USE CaROS 

common /CA2 / A2(76e) 

COMMON /CAS / A3(768) 

COMMON /CA« / A4(768) 

common /CA9 / A5(768) 

common /CA6 / A6(768J 

common /cat / A7(768) 

COMMON /CA8 / A8(768) 

end 
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•DtCK ERRORM 

SUBROUTINE ERRORX 

cedumpm edump for stcm link 


C 

c 

c 

c 

c 


INDEXw u*lo»lesta 

SCHOKEb station choke indicator ( ADUwF.BRHS.WRIOUT) 

MCU « sharp corner indicator (BIDTrS) 

Mct ■ PIgUQ INDEX OF COnTrOl STREAMLINE ( PTrOVE , FLORAL ) 

COMMON /CHDATA/ XI ( 1 ) . LNExT ( 1 > , ML3 1 1 ) . HUB i 1 1 . PR I M H 

1 
1 
& 

& 

S. 

DIMENSION 

equivalence 
integer 


TYPELBmiNAHEL8a)iILB(l>iFLB<X).SlLB(l), 
TYPEUBU) ,NaMEU 8<1) I lUBCli ,FU8(1) iSlUB(l) , 
VMB(l),DWDVa),x2CL(l»,9LSWI(i)|MCL(l), 
ANGTE(I) ,PTTE(1) ,PSTE(l>»rGRTEa>|RGTEm , 
ANGEXPa),8sQEXp(475> 

CRVLEU) ,ANgLE(D 

ISCHOKEfDWDVi ,< cRVLE.AN5TE> angle iPTTfc) 

RRlMiTyPELB,TYPEUB,ScHOKEtl J 


C 


C 


table of index limits 

COMMON /txORiG/ LHO.^LHE 


• LOiLEST 

» MO.NM, 

• LEO, lee 

dimension LIMITS! 

equivalence Ilimits 


streamline table 

COMMON /SLTAB / W(12S)| 


, LBdO.LBDE, lto;lte,' LWO.LWE, lfo.lfe 
A,lS0*LSE»LD0,LD6«l0UM(4) • 

Nj.NrcoLS. maxnj;haxol.maxnm,maxle, 
t l«o,lRe.lRD 

24) 

»LH0) 

X2(128) iSLCHN(128^ 


integer SLCMN 
COMMON /CA2 / 
common /CA3 / 
COMMON /CAA / 
common /CAS / 
common /CA6 / 
COMMON /CA7 / 
COMMON /CA8 / 
cOmmOn /CB / 
COMMON /CCURV / 


A2(300) 

A3(300) 

A4(300) 

AS(300) 

A6(300) 

A7(300) 

AB(300) 

B(300> 

CURV(3pG) 


I 


CQMMOn /CDS2 
COMMON /CDDS2 
COMMON /CFB 

1 


/ 0S2I300) 

/ DDS2 

/ LiMA,MB*PlB,PUB,WF,ChOk8,SUb50N, nk,plbc,pubc, 
XCHOKEi TaREA,VMBC, WRQSTfcWCALC, OV ( 8 ) i QVP ( 0 ) , 

Jsum.vmlbsq 


logical 

COMMON /CIOEX / 
common /CIDEXR/ 
COMMON /CPMIl / 
COMMON /CR / 
COMMON /CRHS / 
COMMON /CSt / 
common /CS2 / 
COMMON /cTaBPR/ 
COMMON /CTOLRL/ 
COMMON /CVM / 
COMMON /CZ / 
COMMON / CLINES 
LOGICAL 

COMMON /BLBDy / 


M» J,'MU*MD, istag 
C2C25) 

PHI1(3Q0) 

R(300) 

RHSI300) 

SX(300) 

S2(300I 

iiTab 

C3<X2> 

VM(300) 

Z(300) 

/ LINES* OMiTFK, 
OMITFK 
IBLB(6Q) 


CHOKBiSURSON 


PTITUE<6i 


call TABPRT(3HCFB,Li33*4) 

CALL TABPRT(5HCIDEX,M*S#5) 
call TABPRT (6HCIDEXR|C2,25,5) 
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CAU TABPRT <6HCT0LSL#C3#6#6) 

UTAB a LO 

CALL TABPRT f6HSTAT>B|Xi#LESTA#5) 

OMlTFK a .TRUE I 
LINES a 64 
call FHEADINM) 

WRITE < 6,t200 i 
DO 50 Mai.NM 
call GETn( 

WRITE ( 6»1201 ) J* «U. MD, iSTAQi S2.(M»i Z(M)» R(M). 

1 eURViMli VM<H» 

50 continue 

WRITE <6;i000) 

DO 100 lai.NM ^ , 

WRITE <6ilOOl) JiU<l)*A2tI)»A3n)iA^(I)*A5{l)rA6(t),A7n),Aa(I), 

1 PS2(l)jRMS(h 

100 continue 

WRITE <6.1002) DDS2 

1000 FORMAT (4H1 M . llX « iHB.lQX . 2 Ha 2, lOX . 2HA3V lOX . 2HA4 j^lOX, 2HA5 . lOX . 

1 2HA6,10Xi2HA7»10X.2HA6«9X|3HDS2«9k*3HRWS) 

1001 FORMAT (IH i 1 3 , 8F12 , 3 < 2R12 1 6 ) 

1002 FORMAT<///0H DS2MX9,ri3,6) 

1200 format {57X,16HFIELD TABLE OUMP/98H J H MU MD I SI 

1 S2 i R RHtl CURV V 

2H } 

1201 FORMAT (lXiI3i3l5i I2 i2FU,6,2f12,6,Fii;6VF12;7.F11,3) 

!F< iBLBMIiNE.O ) GALL TaBPRT(5H8L8DY.'IBLB,"60i3) 

IF( LDEiEQ'.O ) QO TQ 1381 
IITAB a LDO 

call TABPRT(5HBLTAB|‘CH^)AM,LDE,3> 

1321 continue 
LSTOP a 5 

GO TO <999|-999) • LSTOP 
999 RETURN 
END 
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•DECK MCOEr 

subhoutine mcoef 

• HCQEF- MATRIX COEfnClENT »MC0EF* 


C 

c 


INPUT- 

W<J) « SU FLOW 

S1(M) « distance along STREaHlTNES 
B(M) ■ coefficient of THe CURVaTURE term 
station table 

output^ 

Al(M),Ai!tM» , , ,A8(M) a MATRIX COEFICIENT ARRaVS M*t,NM 


star arrangement is , 

A1 a2 A3 


Ad 

A4 

A7 


At> 


a6 


NOTE , A4 is always NEGaTIVE EXcEPT FOR THE FIRST OF UOUbLE POINT 
THEN A4(M)ai,i A0(M)a.i; 


COMMON /ALLCOM/ MACHAiPSA, tsa,pta,tta, axta#'Rqa*gama, 
8, MACHCiPSC, TsC,PTC,TTC, AXtC,’RQC,GAMCi 

& DAx1T|SCAlEAiTTE»CHOTST 

Heal macham. j imachc 

logical axia,axic 

LOGICAL CHOTST 

COMMON /9ENDIN/ NGClNCg I , aCF<2» 

COMMON /CA2 / A2(300I 

common /CA3 / A3<300J 

COMMON /CA4 / A4(300) 

COMMON /CA5 / A5(300J 

COMMON /CA6 / A6(300) 

COf^nON /cA7 f A7(300> 

COMMON /CA8 / A«(300) 

dimension AO(300)rAl<300) 

EQUIVALENCE I AO i'A6 ) , U1 , A5 > 

COMMON /CATM / NX , XD I M,G( 25 ) 

COMMON /CB / BI500) 

COMMON /CBITS / BITS*BLANK 

common /CCUBE / N«C<2)fqi(2j,C2<2).FEND^2> 

COMMON /CCURV / CURV(-SOO) 
common /CFB / L#MA,MBtDF8<30> 

COMMON /CFFINC/ GFF<6) 

common /cfRfin/ aTinf 

COMMON /CIDEX / M, J|MUiMD, I sTaG 

cOmmOn /cmaXiT/ maxref,nRefin 

COMMON /CPI / PI |TW0PI,PIQ2,P104,T0DE6.T0RAD 
COmMOn /CPRINT/ R0D(6) |RDUM(1oJ 
COMMON /CPTMOV/ DPTMOVI2),NODENS 
common /CR / HI300) 

COMMON /CRMS / RHS{300» 

COMMON /CSl / Si<300) 

COMMON /CSS / SSFML4S8EF»SSEANGfSSDF»SSreMD,SSFNDl.» 
& dss<2),«how,RhOmss,tsic;RmOc,rhocss 

integer ssfml 

LOGICAL SSEFi SSDF 

COMMON /CTHICK/ NTHKXi pUMTH< 30l ) 

COMMON /CVm / Vm(300) 

COMMON /CXG / X{6) 

COmmOn /GZ / ZI300) 

COMMON /ERASE2/ 1A0USE( Z6B) ,LaM( 96) 
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C 


heal 

COMMON /IXOHlG/ 

6 

& 

& 

COMMON /SLTAB / 
INTEGEH 
STATION TABLE: 


LAM 

LHO.LHfc, LBdO.LBDE, LT0*LTE; LWO.LWe# lfo.lfe, 
LO»L£STAilSo.lSEiLDUM(6» I 

MOiNM, NJ.NFCOLS, MAXNJ|MaX0L.MAXNM,MAXlE, 
LfcOiLtfc# L”0»LRE*LRD 
V|l(128)iX2(l28)»SLCHN{128» 

SLCHN 


1 

1 

& 

& 

8 , 


index- L*L0,LESTA 

SCHOKE? STATION CHOKE INDICATOR UDJWF.BRHS.'WRIOUT) 

MCL s SHARP corner INDICATOR (BLDTbS) 

MCL * FIELD INDEX OF CONTROL STREAMLINE { PTMOVE i F lOBAL ) 

COMMON /CHPATA/ Xl< i ) » UNExT ( t ) » ML 3 ( I ) , M.UB T • PR 1 M tX ) » 

TYPELB(X),NaMELB( 1 )» ILBUi.FLBIDiSlLBIl) 
TYPEuB(l),NAHEUB(l),luBtli.FUB(X),SXUB(l» 
VMBa)|DWDV(l),X2CL<l>.SLewrtl),HCL(l)r 


ANGTE<XJ,pTTE(l>,PSTE(l),rGRTE(X)|RGTE{X) 
ANGEXP(l) ,B sOEXP<475) 

DIMENSTON CKVLE ( X ), ANGLE ( 1 ) 

equivalence VBCHOKErDWOVi, tCRVLE, ANGTE) , t ANGLE# PTTE ) 
integer PRlM,TYPELB,TYPEU3,SCHOKEfl) 


I 


I 


INTEGER FIELDiFREEiFARFlDiPReS.OLBC 

logical SL8DY,SUBDT 

DATA FlbLD/bHF lELD/ 

data FREE/4HFREE/, FaRFLD/6HFaRFLD/# PRBS/AHPRES/ # OLBC/4H0LBC/ 


BEGIN LOOP THROUGH 
L * LO 


the stations 


begin loop across The streamlines 
800 mA « MLB<L) 

mb k MUB(L) 

NK e MB»MA*1 

call SETM11,i,*LAM,NK) 

call LF IT2D<Z(MA),R(Ma> .UAM.NK) 


IF (NTHKX 

.GT,X 

MANX * 

MAbX 

M B 

HA 

8X0 A2(M) b 

0. 

AS(M) t 


A 4 ( M ) B 

0, 

A5(M) 8 

0. 

A6(M) B 

0, 

A7(M) B 

0. 

A8(M) B 

0. 

MCENTRb 

H 


initialise /CCUBE/ for CUFiTr 

cx(i) » o; 

Cl(2) « 0. 

C2(l) B 0. 

C2(2) « 0, 


C check for special (FREE*RReS, or FARFlD) boundary 
SLBDY b .false, 

SUBDY * .false, 
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IF(M,NE,HA) go to 820 
IF (NODENS Gt;NHEFlN) GQ TO 818 
IF(TYPEUbIl> ,EQiFHEE ,0R, 

& TYPEiea) . eq.farflu iORi 
& TYPELBtD.EQ, FIELD ,OR. 

& TYPELB(L) ,'EQ,OL0C iO«i 
8 , TyPELBiU.'EQ.RRES) SLBDYs.TRuE, 

818 IF( .NOT.SLBUY) GO TQ 825 
820 IF(M.NEiMB) GO TO 826 

iFjNODENS.Gt.'NREFiN) GO TO 822 

iF(Typeubil) ;eq;fhee .or, 

& TYPEUB(L) .'FQ.FArFlD ,0Ri 

& TYPEUB(L) ;EQ-,F1ELD ,QK. 

& TYPEUBtD.EQ.OLBB ,QR, 

& TyPEUbIU) .EQiRRES) SUbdTs.JRUE, 

822 IFtSUBDY) GO TO 826 

C SOLID WALL boundary 

825 A4(M) ■ -i; 

GO TO 980 

interior point 

build X, Table of distances Tq NEIQRbOBINQ points along the STReaMLI 
POINTS WITH ISTAGS3 ARE TO Be OMITTED. 

SPECIAL END CONDITIONS ARE Tq bE UTiliZEB IF ThE X. TABLE IS T 
By A stagnation POINT 

826 call GETlX 

jCENTRi J 
ISTAGCi ISTAG 
X(4) « S1(N) 

ICl « 4 
IC2 f 4 
NBC(1)» 2 
NBC(2)« 2 
C2(l) E 0, 

C2{2) 1 0, 

HDOWN e md 

831 M ■ MU 

IF(M,EQtO) GO TO 850 
CALL GETlX 

IF(ISTAG,EQ,3) GG to 831 
X(3) E SKMl 
ICI E 3 

IF (IsTaG.NE.O) go Tq 850 

IF( SSFML.LT’.O .and. 8(MCENTR),GE.0. .AMD',* PDUM (12 ) ,EO , < -1 . ) ) 

& GO To 050 

841 M E MU 

IF(M,EQ,0J go to 850 
call GETlX 

IF( lSTAG,’E0f3) GO TO 841 

X(2> ■ Sl(M) 

ICl 4 2 

846 IF( B(MCENTK) .GTVO, ) (?Q TO 850 

1F(IABS(SSFML)VEQ.1 ) GO TO 850 
M B MU 
IF(M,EQ,oj Gq TO 850 

1F(^STAgJeQ,3) go to 846 
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xd) « si(M) 
ici « 1 


c upstream streamline end condition 

850 IF(MU> 854i» 52|854 
852 NBC(D« NBClN(l) 

FENDa) = ACf (1) 

c downstream points, bypass for supersonic Flow 

854 IF (B(MCENTR) ,LE,0, ) GO TQ 874 
HD 8 HDOWN 
856 M 8 MD 

IF(M.EQ.O) go TO 870 

call getix 

IF( ISTaO,EQ,3) go to 856 
X<5> * S 1 (M) 

1C2 a 5 

IF( ISTAG.NE.O) go TQ 865 

1 F« SSFML.LT;0 ,AND. PDUM(12) , 6 q, (-i; > ) go to 865 

861 M s MD 

IF(M,EQ,0J go to 870 

call getix 

c if(B(m),le;o. ,anu, b<mu).le,o,> so to 974 
IF( ISTAG.E0,3) GO TO 86 i 
X(6) s S1(M) 

IC 2 a 6 

c special downstream end conditions for leading edge stagnation point 

865 IF( ISTaG.NE.D GO TO 870 
NBC(2)a 4 
LL » 0 

call STANO(M,lLiUPPER> 

CX(2) a CRVLE(LL) 

FEnD(2)=1, 

IF(ABS<PDUM(5) ) ,Qh,5, ) FEND(2)80, 

c downstream streamline end conditions 

870 IF<MD) 878,872,878 
872 NBC<2)a N8ClN(2) 

FEnD(2)=ACF(2) 

GO TO 878 

c boundary condition on 4-point supersonic beam-curvature formula 

874 FEND( 2 )=SSFEND 
FENDdJsSSpNDl 
NBC(2)< 0 
NBC(1>« 0 

C CALL CUBER to obtain SECOND QRdER OIFFERBNCE FORMULA, D2< ON ) /D ( Si ) 2 
C ANSWERS are STORED IN GUG,JG), JG»l 1 G2*l Ql^l , IG 5 MIU POINT 

878 NIC * 1C2"1CI*1 

IF( isTAGc;ea.' 3 ) so to eao 

1F(N1C,LE,2> GO TO 9q6 
call CUBERS(x(ICt),NlC) 

GO TO 900 

CALL CUFITR FOR INFLUENCE COEFFICIENTS, DS 8 < 3 ) aF ( DS2( 1 ) 1 DS2 < 2 ) , OS ( 4 
FOR infield boundary P0lNT<lSTAGa3) 

880 call CUFITR(X< let) ,NlC,5-ICi) 
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C«»*«0EriNE AIL COEFFICIENTS OF ThE EQUATION F08 FIELD POINT M 
IG • 

JG s IC»lCl*i 

IJQ ■ •* IG 

IJQ ■ center point INDEX IN Q^ARRAY 

900 IJQ 9 29>1C1*6 

if(pdum(5);le,o; I go to 9q4 
IF(ISTaGc;NE;3 -.and, PDUH(5),eO;3.) go to 904 
IF(PDUM(5) ;GE,4, ,AND, N8C<2).NE,4) GO TO 904 
WRITE <6,1904) JGENTR iMQEnTR , 1 Cl , 1 C2 , IjQ 
19 q 4 FORMAT(//3y JsI3|9H MC6NtRsI3i 7H 1C1«IJ,7H lC2?I3i6H UG8I3) 
call TABPRT(lHX,X( IGDlNlCiS) 
call TABpRT(5HCeUB6<'NBC#8,8) 
call TABPRT(JHQ,G,25.5| 

904 continue 

c set correction eq deceleration Factors 

906 M * MCENTR 

IF(8(M),LT;0,') go TO 908 
RHOWW 9 RHOW 
BUSE 9 RMOC«B(M) 

GO TO 909 

908 RHOWW * RHOWSS 
BUSE * RHOCSS*BfM) 

C CHECK FOR INFIELD BOUNDARY PoInT OR SPECIAL BOUNDARY 

909 IF( ,N0T iSLBDy ,ANU, .NOT.sUBDY '.ANDi 1STAQC,NE,3) GO TO 910 
GO TO 926 

C FIRST POINT OF A DOUBLE SL , CHECK W(JCENTR*D 

910 M « MCENTR*! 

CALL QETIX 

IF(W( JJ ,NE',0,‘) GO TO 915 
M 9 MCENTR 

J ■ jcSntr 

GO TO 926 

C points 7i 8i AND 4 
9l5 JP 8 j 

MP * M 

JM B JCENTR 

M a MCBNTRbI 

IF<W( JCENTH) ;nE,0, ) GO TO 920 

Call gettx 

JM 8 J 

M « MCENTR-2 

920 CALL GE^I^ 

MMl a M 

JMj B J 

M a MCENTR 

J a JCENTR 

A7(M) a RH0WW/(WNM)*W( JMl) ) 

A8(M) b RHQWW/(W( JP)-,W( J) ) 

K ■ M.MAMl 

A4(M) b LAM(K)*(i»A7(M)«A8<M)) 

A8<M) s LaM(K*1)»A8(M) 

K ■ MMt-MAMl 

A7(M) 8 LAM(K)«A7<M) 

I^( ,NOT, AXiA) GO TQ 926 
A4(M) 8 TW0Pl«R<M)aA4(M) 
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A7(M) > TW0PI*R{MM1)»A7(M) 

A8(M) ■ TW0Pl»R«M*l)«A9lM) 

C POINTS li 2, 3, 4, 5, AND 6 
926 ir(NlC.UE.2) GO TU 938 
IF(JC1,NE,0 ) GO To 930 

930 GO TO (931|932«933i934J*IC1 

931 A1 (M) b BUSfc»G{ I JG* j 5) 

932 A2(M) s RUS£*G< I JU.IO) 

933 A3(M) s RUSE:«G( IJG«$) 

934 A4(M) b BUSt»G< IJU>*A4(M) 

1F(JC2-5) 938i935i936 

936 A6(M) 9 BUSE«G{ I JU*lO) 

935 A5(M) a BuS^»G( I JG*5 ) 

modify influence coefficients to accommodate double streamline 
MX a dummy point 

MT a TRUE POINT 

MX IS THE FIRST POINT, EXcEpT FOR CASC PROG WITH UPPER OLBC, 
then MX IS the SECOND POINT, 

938 IF(W( J) iNE'.O; .OR.SLBDY) GO TO 940 
MT a M 

MX a M*1 

IF(TYPEUBa) ,"NE;QLBC) go to 9392 
MT a M*1 

MX a M 

9392 IF(ISTAGC iEg, 3) GO TO 9394 
A2(MT)a A2»M)*A2^Mal ) 

A3(MT)a A3(M)4A3IM«1 ) 

A4(MT)a A4!|M)*A4IM-1 ) 

A5(MT)a A5(M)*A5IMal) 

A6(MT)» A6(M)*A6JM»1) 

IF(mx,ne;m) go to 9394 
C MX*M and MTaM*l 

A7(M»1>=A7<M) 

A8(M-1)=A8(M) 

RHSV • RHS(M-1» 

RHS(Mfll)aRHStM) 

A7(M) a -1; 

A8(M) a 0, 

RHS(M)a *RMSV 
GO TO 9396 
9394 A7(MX>8 0. 

A8(MX)« •!', 

9396 A2(MX)= 0, 

A3(MX)a 0, 

A4(MX)a 1, 

A5(MX)« fl, 

A6(MX)a 0. 

C FREE, PRESSURE AND FaR-MELD BOUNDARIES 
C LOWER boundary 

940 1F< ISTAGC,EQ;3) GO TO 980 
IF( ,NOT,SLBOY) GO TO 950 
!F( ,NOT| AXIA) GO TO 94? 

A4(M) a A4(M)»TW0PI«R{M)«LAM(1) 

A8(M) a TW0PI«R(M*1)«LAM(2> 

GO To *80 

942 A4(M) a A4(M)»LAM(1) 

A8(M) a LAM<2) 

IF{TYPELB(L»;NEiFARFLO) GO TO 980 
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C STAREA* stream tube area 

STaREa* RIM^d-R^M) 

ir(AXlA) STAREA*R|*<R(M)tR<H*l))«STAREA 
945 call FFINC 

VQaTSQA VMlM|*VM|M)/(ATlNr*ATlNP) 

BETA ■ l.aVQATSB/(l,«|t*VQATSQ) 
irOETAjGT'.O;) 90 TQ 94Z 
WRITE <6 ;i946) H 

Call errorj 

947 beta • SORTiBETA) 

BA ■ BETAfSTABEA 
A2(H) • A2fHUBAtGFF(2) 

A3(M) f A3|M).BA9GFF(3) 

A4(M) i A4tM)*BA#GFF(4) 

A5(M) 4 A5|MI.BAfGFF(9» 

A6(H) « A6(M|«BA«QFF(6) 

90 TO 980 

C UPPER boundary 

950 1F( ,NOT,SUBOY) GO TO 909 
K • M-MAMl 
IFIAXIA) GO TO 904 
A4<M) f A4<M).LAId(K} 

A7(M) • LAM(K«1) 

GO TO 966 

964 A4(M) • A4(M)«TW0PI«R(M>4LAhU) 

A7(M) • TWQPl»R(lj-tULA0<K«U 
966 IF(7YPEUBH)7NE;fiARFLD» GO TO 980 
STAREA* S(M)«R(I4«U 

IF(AXIA) STAREA«RI«<R(NI4R<M^1))«8TARBA 
90 TO 949 

980 M i Hc|NTR*X 

IFIM;le,Mb» QO to 8(0 
C?,,;,IN0 LOOR across the STRBamLINeS 

C INDEX TO NEXT STATION 
L • L*LNBXT<LJ 

1F(L;UT,LE8Ta) go to 800 
c ;,,; .end loop through the stations 

RETURN 

(946 FDRMaT(76H SORRY . SuPeRSONIC VELOCITY ENCOUNTERED ON FAR FIE 

&L0 boundary AT PQlNTi If* 9^ (kCOEF)) 

END 
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• DEC*^ 

subroutine ATDMMS 

• ATDMRS AUGUMENTED TKIPIaGO'^AC matrix reduction •ATDMRSR 

c SMALL matrix VgRSION 

given The matrix sguaTion ax*bt» 
find Q so that x^gy, 
note X and Y are VECTORS, 

input, 

A » TRIUIAGONAL coefficient matrix of X 

B S tridiagonal coefficient matrix of Y (STORED IN Q-ARRAY) 

(OTHER OFF*DIAGOnAl ELEMENTS MUST BE INITIALUED TO ZERO) 
IDIM . FIRST SUBSCRIPT DIMENSION OF MATRIX B AND G 
N » order of matracies 

order or storage is illustrated by- 

A(2il) A(3,l) {A(I.IJ) B(l*2) 

A(ii2) A(2,2) A(3 i 2) 3(2.1) B(2i2) B(2,3) 

Ad. 3) A(2 i3) A(3i3) B(3«2) B(3|3) 3(3*4) 

(A(3,4)) A(1,4) A(2#4) B(4*3) B(4»4) 

C OFF DiAtiONAL ELEMENTS OF b MUST BE SET TO ZERO 

C OUTPUT- 

C G « INVERSE(A) « 3 

COMMON /ERASE / A(3,100), UuM(500) 
common /CATM / NiIDIM,G(25) 

C«»« FOHHARD REDUCTION 

A(3d)> A(3il)/A(2,l) 

G(l) * G(i)/A(2,l) 

G( lDlM*l)*G(IDlMtl)/A(2rl ) 

I ■ 2 

C SPECIAL LOGIC FOR INCLUDING A(4,i> WHICH IS STORED IN A(l,l) 

A(lil)» Adil)/At2,l) 

QA2I ■ l./(A(2ia)^A(l|2)«A(3,l)) 

A(3i2)m QA2I*(AI3,2)-A(1,2)»A(1,1)) 

GO TO 97 

90 QA21 ■ 1,/<A(2,I)»A(1|I)*A(3,U1)) 

95 A(3,I)= QA21«A{3,I) 

97 U i 1 

I J * T 

120 G(I«I) B QA2U(G( IU)«Ad* I )«G(IU-1) ) 

IF(U-l) 140il40iJ60 
140 IF{J-»N) I50il60il60 
150 J « J*t 

U • IJ*ID1M 
GO TO 120 

l60 !F(l"N) l70ii8o,l7o 
170 I « 1*1 

C special logic FQR including a(N,N-2) which is stored in A(3»N) 

IF(I^N) 90»172,172 
172 A(1,I)« AUiI)'A(3,I)*A(3,U2) 

J « 1 
I J ■ I 

178 GdU) • GM J)<-A(3i I )«G<1U.2) 

179 J B J*1 
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!J « TJftlDlM 
!F( J«m78r90(9Q 


C««* BACK SUBSTITUTION 
180 I ■ I*t 
C 1F(I) 900.90Q.19Q 
190 J « 1 
IJ « 1 

C special logic FOH INCLUPING AC4,1> WHICH IS STORED IN A(l,l! 

192 1F(1,1> 900,195,300 
i95 G(IJ) I 6el>J)-A(|,l)*G< I J*2) 

2QO GdJ) B 6(1J)-A(]|I)«G<1J*1) 

IF(J,EQ|bn GO TQ 180 
J • J*t 
IJ « TJ«1D!H 
qO to 192 

900 RETURN 
END 
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•DfcCK CUBfc 

subroutine CUBE<X,YjNN*B) 

«CUHE.-i. FIT A SERIES OF CUfllCS TO POINTS 

• END CONDITIONS ARfe ARBITRARY 

dimension X(10)i¥a0)*BU0) 

ON ENTRY • 

XiY * LISTS OF coordinates 
N « no; of points (N.Ge.a) 

ALSO DkFlNbO ON ENTRY • IN COMmON/CCUBB/ - 
NBClL)* boundary CONDITION INDICATOR FOR LEFT(L?1> 
« 0i li OR 2 

YP(L) ■ FIRST DERIVATIVE IF NBC(L>»1 
YPP(L)» second derivative if N0C(L)s2 

C ON RETURN, 

C 8<n f FIRST derivative AT POINT I (1«1,N) 

COMMON /CCUBE / NBC 1 2 ) i YP ( 2 ) , yPp( 2 ) i FENB < E > 

COMMON /eCUBIC/ Ni I Ai IB 

common /ERASE / A ( 3 i'266 ) i DRASE < 2 > 

LOGICAL PARAB 


c initialize 

N * NN 

lA 9 2 

IB « N,t 

DXl a X(2)-X(l) 

OYI a Y(2),Y(U 

DXN • X(N)^X<N«1,) 

DYN a Y(N)3Y(N*1) 

C note PDXNP is the delta X FOR THE (N»l) INTERVALi 

C MORE precise symbol, 

C A straight line is used for N*2 if NBCdlaNBClZIaO 
NBCS a NBCai*NBC(2) 

1F<N,gT,2 ;oR, N8CS,g^,0) Go ^0 50 
bid a (Y(2)«Y(I ) )/(Xt2),X<l) I 
B(2J a B(l) 

GO TO 900 

C CHECK IF parabola (FaOl SHOULD BE JSED 

50 parab a (n;eq,2 ,*and, (nbc(d*nbc(2M ,eo.{i> ;or, 

1 tN;Eo,3 ;and, nbcs,eo,o> 

C NBCaOl, Y and yp specified 

c left end 

1X0 1F(NBC(1J .NE.Oi) GO TO 120 

A(2,1)b 1, 

A(3il)a 0, 

Bd) a YPll) 

c right END 

120 IF(NBC{2} .NEVOI} GO TO 210 
A<l|N)a 0, 

A(2,N.)a 1, 

B<N) a YP(2J 

C N8Cs02, V AND SPECIFIED 

C LEFT end 
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AND RIGHT(L»2) 


DXNMi Would be 



210 IF(NBC(1) ;NE7021 QO to 280 

A(2iD# a; 

A(3|l)« 2, 

9<1) • » YPf»U)tDxl 

C RIQHT 

220 lF(NBC(2riNE;02} QO TO 910 

A(iiN)< a; 

A(2iN)» 4 ; 

BIN) A YPP(2)#D2N « 6,*DyN/0xN 

c NBCio, yppp s f • yppptoF adjacent INTSRVAU 
C LEFT END 

310 iF(nbc<ij;ne,’o) bo to «ao 

A(2il)i 1. 

A(3i1)« 1 ; 

0(1) • 2;*DV1/091 

IF(PARABJ QO to }20 
QXa 9 X(3).X(2) 

0V2 • Tn)-Y{2) 

DX1DX2* DXS/0X2 

A(2il)t Ateil) T FEND(1 )*DXiDX2 

A«3#l)i AH,1) « FeND(l)*DXiDx2*(2>DXlDxa) 

8<1) « Btf) ♦ F|NDU)#13.«DY1*DY2*DX1DX2ADX1DX2)/DX2 

C RIGHT END 

320 IF<N0C(2I;N£;o) flO TO $00 
A(tiN)i| 1 ; 

A<2iN)« 1 ; 

0(N) f 2;fD¥N/0«N 
IF(PARABj go to 500 
DxM i XlN»i)«XlN«8) 

DYM f VlN»l)tfY(N«2) 

Oxnoxm* DXN/DXM 

A(l|N)f AUiN) « FENO<2)#OXNOXM»<2.*DXNDKh) 

A(2fN)« AUfN) ♦ FENO(2 )«OXnOxM 

0(N) • BIN) ♦ F|ND<2)*|3,«DVN*DYN*0xNDXM|DxNDXM)/0xM 

500 CALL cUbTc8<X,Y^P) 

900 return 
end 
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•DECK CUBERS 

SUBROUTINE CijBERB ( X iNN J 

•cuhers ypp in terms QF y pCubersp 

C FOR CUBIC SPLINE EQUATIONS 

C SPECIAL small NAT«iX VeRSiOn WITH END CONDITIONS FOR »STc 

DIMENSION X(10) 

ON entry . 

X « LIST OF DISTANCES 

NN s no; of POINTS (N,GE,3) 

ALSO defined on entry • IN COMmON/CCUBB/ =. 

NBC(L)» boundary condition indicator for LEFTiLbII and RIGHT(L«2> 

* 0 IF FEND(L) IS Specified 

* 1 FOR YP(L)=0, 

« a FOR YPP(L)^0| 

m 4 FOR YRlDs-CllL^^YlL) AnD YPPP ( L > «TBND ( L ) »YPPP ( NiX T 
FEND(L)= END/NEXT TO END VAuUE OF yPPP IF NbC(L)«0 

C ON return- 

C G(1,J)« matrix defined by C*GY RHERE C is A VECTOR OF SECOND DER 

common /CATM / N| IDIM,8(5»5) 

common /CCUBE / NBCI2) |C1<2) ,c2(2) .FENDtai 

COMMON /ERASE / A ( 3 , 266 ) » DR ASE < 2 > 

c««»*oefine coefficient matkicies 9a» and pb»* where A»YPP*B«Y 

c initialize 

N « NN 

Fl a FEND(l) 

F2 ■ FENU(2> 

IF(N-3) 60|65,70 
60 call ERROR! 

65 Fl a 0. 

F2 • 0, 

70 call SETM(2,0.i Alls. B,25> 

0X1 * X<2).X(U 

DX2 > X(3)«X(2) 

DXM ■ XtN*l)'^XfN^2) 

DXn 8 X(N),X(N«1) 

C note fDXN* IS THE DELTA X FOR THE <N»1) INTERVAL, DXNMX WoULO BE 

C more precise SYMBOL, 

lA a 2 

IB « N-1 

C NBCaOl , YP40, 

c left end 

110 iFiNBcai ; ne,oi) go to 120 

A(2il)a DXt*DXl 
A(3il)» DXl 
B(li2)« 6;/Dxi 
B(lil)« .6(1,2) 

C RIGHT END 

120 1F(NBC(2J ;nE; 01) GO TO 210 
A(liN)a DXN 
A(2iN)c DXN*DXN 
B(N|N,l)a6;/DXN 
B(N,N)a -B(N,N-U 
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c NBC« 02 , ypi*»e. 
c left end 

210 lF(NBC(ir,NE;o2) GQ TO 220 
A(2ii)f 1. 

C RIGHT END 

220 lF(NBC(2r.NE.'02) GO TO 9t0 
A(2iN)» 1, 

C NBC«0, YPPP • r • IfPPPlOr adjacent INTIRVal* 
c LEFT end 

310 1F(NBC(1| ;ne;o) go to 520 
AdiDii F19DX1 
A(2»i)» DX2 
A(3i 1)9 •DX2.A(lkl) 

C RIGHT END 

320 IF(NBC<2).NE;o> 60 TO 41Q 
A<3iN)« F29DXN 
A(2iN)« DXH 
A(liN)a «DXH«A(3|N) 

C NBC.04, yPiCl«Y AND ?PPP«r*YPPP(NEXT TO END! 

c left end 

410 !F(nbc<i);ne;o4j go to 420 
CALL ERROR! 

C RIGHT END 

420 1F(NBC(2} ,NE;o4) go to 900 
A(2iN)ii 1. 

IB « N*>8 
AOXN k Cl(2)oOXN 
CIPAD • l',*A0XN 

A(l|N«t)4 OXH ♦ F2*0XN«DXN/DXH«(3,*ADXN)/C1PAD 
A(2iN«l)« A(1 iN«|)*DXMt9,»0xN«(2,4ADxN)/C|P«D 
B<N»liN-ajA6,VDXM 

B(N*1iN-1JP«6,9U./0XMtC1(2) /CIPAD) 

C CUBIC RECURSION F0RMULA BASED ON MATCHING YP AND TPP 
900 IFUB.LTdA) GO TO 600 
DO 550 UIA,IB 
A(li I )tX(I )«X(U|) 

A(3il )9XtI*l)«XU) 

A(2iI)P2;»(A(l,n*AU«P) 

BniI«l)s6:/A(l|U 
8( li 1«1)46;/A(3| I) 

950 B(r,n6-Bf1iI-l)f8(I,I*U 

C*»**0BTERm 1NATI0N OF fGP BY MATRIX REOJCTlONi YPPAG^Y 
600 lOlH • 9 
call ATDMRS 

900 RETURN 
END 
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•D&CK CUBICS 

subroutine CUBICfU|Y*B) 

•CUBiCS SERIES BF CUBIfiS FjT TO COORDINATE POINTS PCUBlcS* 

DIMENSION X(100>i YU00*» B(100I 

input- 
X( I ) >Y< I) 

A(iiI),A(2|I),A(J,l),0<I) 1*1, (U»l) AND I*iIB*x),N tl.E, B.C 

IA,1B RANGS IN WHICH THE COEFFICIENT MATRfX AND CONSTANT VECTqR 
be DeriNfD BY equations for MATCHtNa YP AND YPP, 

iiN Range of x,v, and b 

OUTPUT 

BID SLOPE AT X(J) 

COMMON /CCUBIC/ NilA.IB 
COMMON /ERASE / A(3j266)« DrAsE( 2 ) 

set UP tridi agonal coefficient M 4 TR 1 X A and vector b, order OF 


STORAGE IS illustrated BY • 

A(2,l} A(3fl) B(l) 

A(l,2i A(2|2) A(3i2) B(2) 

A(it3) A(2i3) A(5,3> B(3) 

AUi4> A(2,4) 8(4) 


C 1 a POINTS at WHICVI YP aND YPP ARE MATCHED 

C lA.lB • LIMITS OF I 

if<ib.lt7ia) go to iOO 

DO 70 I^'TAiIB 
A(lil)a Xll*l)-XH) 

A(3,I)» X(l),X<I.l) 

A(2il)|i 2.«(A(1 iI)«A(3aI)) 

7 0 BID •37*l(Y(I*l)*¥(U)*A(3#I)/A(l,l)*tYeiT-¥n-l)I*AU.iI )/A(3.I ) 

II 

C ROUTINE TDSEO - TRIDJABONAi, SIMULTANEOUS EQUATIONS 
C SOLUTION TO aX?P, on ReTuRn SOLUTION VECTOR X IS STORED IN B. 
100 A(3»l)« A{3f 1)/A^2,1) 

8(1) • Btt)/A(2il) 

DO 150 I«2,N 

A(2#I)a Al2il)-A|1,1)PA13,U1) 

A(3iI)B A(3i I )/Af2, 1) 

150 B(l) 4 {Bn)-A(l,n*B<I-lM / A(2.I) 

I ■ N 
200 I • T-t 

1F(I,LE,0J go to 900 
B(I) i Bin-AO, DtBd*!) 

GO TO 200 

900 ret'Jrn 
end 
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•OfcCK CUFlT 

subroutine CUFITIX, V.NPTS, NEWi XC, YC*NXC,NDi bj 
•CUFIT. •CUFItP 

C integrate, INTERPQUaTe for coordinates, 1ST, OR, 2ND DERIWAT 

C BY A CyBIC SPLINE CyRvE FfT 

LOGICAI. NEW 

dimension X<10)|V(10)i XC(10‘ .YcdO), 8<10) 

C NOTE, the dimension •10* DOES NOT NEED To AGREE HITH THE CALLING 

input« 

Xi Y PTS, ON CURVE 

NPTS no; of X 

NEW *1 (,-TRU6,) TO fit CURVE. afl (;FaLSE,) TO USE LAST FIT 

xc list of X aT which calc To be done 

YC(l) integration constant if nd*-i 

NXc no; of xc 

ND *0 To get GOORDr =1 OR 2 TO GET 1ST OR SECOND DERlV, 

«"1 FOR integration 

output 

YC COORDINATE OR DERIVATIVE AT XC OR 

YC(lC)8 INTEGRAL(Y»DX) from XC(1> to XC(IC) where IC82.NXC 
B<I) FIRST DEHJVaT AT pOiNT 1 Uai,N> 


notes* 

•X# MAY BE IN either ASCENDING OR DESCENDING ORDER, 

FOR integration fXc* MUST BE iN Tre SAME ORDER AS *X*, FOR INTeRP 

NO special order is required; 

LOGICAL Within 

C FIT the cubic spline 

IF( iNOTiNEW) go TO 100 
call CUBEIX, y,npts, b» 

C interpolate 

100 I a 1 

do 150 IC*1|NXC 

C LOCATE appropriate InTeR^AL 

WlTHINa , false , 

NCOUNTiNPTS 
N = NCOUNT"! 

101 NCOUNTaNCOUNT-1 

if(ncount,eq;o) go to 120 

F S (XC( I c) "XI I ) ) / (X< Ul)«x< I > > 

1FIF,GE,0.) go to 110 

C f.lt.o, 

IFM ,EQ,1) go to 125 
IF(ND,EQ7(al) ) GO TO IgO 
I a I ■! 

GO To lOl 

110 IF|F,LE,1.) go TO 125 

C f,gt,i,o 

1F(1,EQ|N) go to 125 
IF{ND,EQ, twin GO TO 126 
112 I a 1*1 
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ttO TO 101 
120 call ERROR! 

c preliminary calculations for interpolation or inteqration 

129 WITWIN«,TRU6; 

126 DX « Xtl*l)-X{l) 

OY q Y(I*1),Y(I)) 

D ■ tBU I*Bi l!*l>-2,#0Y/DX)/(DX*DX) 

C « t3;*DY/0«-<2.*B(l)*B<I*im/DX 
XD « xcnc).XH) 

L » NjJAg 

50 TO (130il40il41,|42)fL 

C NDs-li INTEGRATE 

130 |F( iNOTittlTHlN) XDaDX 

51 f tYd) * (BM)/I, ♦ <C/3, ♦ D/4>UDI*XD>aKD)*XU 

C I J^BE?NG°?Nc86?liSTE0 TO FIND APP'^OPRlAtE INTERNAL, HENCE* 

c cumulatb thb integral Qf The ith interval, 

SA S SA 4 31 
GO To iia 

c appropriate interval found, xnJ*xC(iciixn*i) 

139 lF(lC,e07l) SA=Y6(lBl-5t 
IP(IC,N671» VC(|C)aSA*St 
GO TO 150 

C NO?Oi interpolate FOR COORDINATES 

140 YC(lC)t Ytl) « (BU) * XQ * 0»X0)«X0)*XD 
GO TO 150 

C ND«I» FIRST derivative 

141 YC(lC)« Btl) ♦ <ai«C * 5 i«D*XD)*XD 
GO TO 1-50 

C NDf2i SECOND derivative 

142 Ycno* a;«c * 6 ;*dixp 

150 continue 

return 

end 
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•DBCK COrlTR . . 

SUBROUTINE CuFlTB(XfNlCrlMlD) 

•CUFITH T 6 MR 0 RA 8 Y ROUTINE FOfl 

DBTBRMININ 6 INFUUBNCE COBrFlCieNTS 
FOR INFIELB boundary POINTS 

wMiCH tbrhinatb »part!au oRthobonaus* 


DIMENSION X( 4 ) 

common /CATM / NX,«DIM#G< 9 , 5 ) 
DIMENSION V( 4 ),i< 4 ) 

X 3 i XUMID) 


C SHIFT X-ELEMENTS ABOVE •IMID# TO THE LEFT 
NMQVE ■ N 10 » 1 MI 0 

call MOVEJt,X( IHJD*l)iXUMlo),NHOVE,l) 


Nl i NIC . 1 
DO 60 l^IiNl 
DO 50 IlgllNl 


50 Y(ii) ■ o; 
vij) • i; 

60 call CUFTT«X,YiNIC* 1 i 


iTRUE.i X3,fi(lMID;n*(>0*5) 


C SHIFT G<IM1D,I) T0 THE RIGHT FqR 1,QT;1MID 
I 9 Nl 

70 QMMlD.UlI ■ GllMiD.ll 

I i T*t 

IF^I.Oe.lMlD} GO TO 70 
6(lMI0,lMI0)«.i; 

RETURN 

BNd 


•CUFITRP 
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•D6CK FFtNC 

SUBROUTINE FflNC 

CFFINC ' INFLUENCI COEFFICIENTS ON FAR FlEuD BOUNDARy 

COMMON /CFB / L #MA,MB»DFB( jq ) 

COMMON /CFflNC/ QFFU) 

COMMON /CFRFiN/ 0MU)ii0NliZDN29 
COMMON /CIDEX / M, JjMUiMO, IST aQ 
COMMON /CSi / BK300) 

COMMON /eZ f 2(300) 

c 

1 M « MB 
CALI GCTTX 

ODSl • 2,/(Sl(M0)»8l(MU}) 

C compute JNFLUgNCE COEFFICIENTS 
GFr(2)» 0. 

GFP(6)p 0, 

1F( MU.EO.O ;oR; MD,EO,0 > go to 20 
GFP(3)i .,869*QD|1 
GFf<4)« •2;«6FF(]) 

GFf(5)« GFP(3) 

GO to 2 
20 GFP(3)« 0, 

6Fr(5)A0; 

!F( MD.EQ.O ) GO TO 25 
DSl a S1(MD)«8|(M) 

QFr(5)« -,865/DSj 
ZL • Z(M)«Z0N| 

RATIO A nZL«DSl)/ZL)«»8 
GFf(4)# GFr<5)«<BATIO-2i) 

GO TO 2 

25 OSl • 81(M).S(fMU; 

QFf(3)» •;86J/DSi 
ZL > ZDN29-ZiM) 

RATIO a nZL«DSt)/ZU«*9 
GFf(4)A 6FF(3)«(8ATIO-2i ) 

2 RETURN 
BND 


-FFlNC* 


313 



nooo ociorjono o cj o 


•DtCK DUP3 

SUB«0UTINP UFIT2D(X|YiT0,NXY) 

•LF1T2D LINEaK JURFACfc INTERPOLATION PlFlT2D» 

C IN A rectangular GRID 

dimension X(2)iY{2),Tq(2) 

INPUT. 

x,y b list of coordinates at which interpolated Values are to be 
NXY B NO OF COORDINATB POINTS 

NXT 8 number of XT 

NYT a NUMBER OF YT 

XT B X.GRID OF TwTABLE 

yt 8 y.grid of t.table 

t b Table of values 

NOTE . NUMBER OF T. VALUES IS NXT«nYT» ORDER IS ILLUSTRATED BELOW 


YTINYTJP 

T(3J 

T{6> 

T(NXT#NYT) 

Yt(2) • 

T(2) 

T(5) 

T(8) 

YT<1) • 

T(U 

T(4) 

T(7) 


XT(1) 

XT (2) 

XT(NXT» 


c output. 

C TO B interpolated values at XiY 

common /CTHICK/ NXT,'NYT,XT(20)»YTI20>;T(78) 
common /erase / OUM(400),T1(200),T2(200) 

C find CORRECT X-INTERVAL 

I • 1 
M B 1 
ISV B 0 
100 NCOUnTb 0 

105 lF(X(M),LTiXT(I)) GO TQ UO 

!F(X(M) ,6t;xt( i*in go to 120 
F p tX*M).XTH M/(XT(I*1 ).XtTI>> 

GO To 150 

no IFd.EO.l) go to 140 

I B I -1 

GO To 125 

120 1F( (dl) .GE.NXT) GO TO 145 

I « !♦! 

125 NCOUNTb NCOUNT*! 

IF(NcOUNT.GT;nxT) call ERROrI 
GO TO 105 
140 F B 0, 

GO To 150 
145 F 8 1. 

c interpolate WRT V 

150 IF(1,EQ,ISV) GO TO 160 
U2 B I»NYT*1 

IJl 8 TJ2-NYT 

call LFlTlIYT# T( IJiJ.NyTi Y,TiiNXY) 
call UFlTilYT,T(ig2).NyT, Y.Tj.nXY) 

ISV B I 

C interpolate WRT X 

160 TO(M) 9 FBT2(M)*a,.F)»Tl(M) 

M ■ M*1 

IFjM.LEfNXV) GO TO 100 
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C;,, end loop for INTiHPQLATlONQ To(M) AT X(«UV(M),M«liNXY 
RETURN 

end 
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•DBCK SS5PTI ^ 

SUIROUTINE SS5PTt(X»,ol 

•SS5PTI SUPBRSONIC 5-PT iNfLUENCB COEFFICIENTS 

DIHBNSION XX(5)|fi(29) 


•SS5PT1P 


*XX^^* • STREaMWIIE BISTANCE of four point*. XX(l)*.,X(4» 

OUTPUT.^ change in second derivative, 02^0*2; per WNIT CHANGE IN 
VY(0)r.7»Y<4> 

common /CS85PT/ X(4),Y(4), X2liX3l,X32;X4i.XA2,X43, AOi Al,A2f A3, A4 


c X(0) f 0. 

DO 65 I°I,4 

69 X(l) 4 XX(I41>«XXU) 
CALL SS5PT 
G(9) • aO 

GdO) • A1 
S{19) • A2 
Q(20) it A3 
0(25) M A4 
RETURN 
END 
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•DtCK lAD 

SU0HOUTJNE UD 

•lAD implicit alternating 

INPUT 

MUB|MUB»L0|UNBXT*--STATI0N 
0(M) = indicator (B.GT.O. 


direction ROUTINB--STC 


• I AD' 


table 
SUBSONIC) 


(B.LE^O SUPERSONIC) 


AI.A2, A3.A4, a5, A6, A7#AB « INFl^^ENCE COEFFICIENTS 
RHS<M) = right hand SIQES OF MATRIX EQUATION 
A4(M) s 1, FOR FIRST POINT OF DOUBLE ST»EaMLINE 
lADM = -1 LINE relaxation AlONG STREAMLINE 

IADM s 0 alternating orthogonal* streamline relaxation 
UDM S 1 line «ELa)<aTioN along Qf^THOGONAL 

station Table 

INDEXi. L*LOiLESTA 

SCHOKE« STATION CHOKE INDICATOR ( AD JWF , BRMS ,'WR I OUT ) 

MCL » sharp corner indicator (BLDTbS) 

MCL » field index of control streamline (PThOVE,FlOBAL) 

common /CHDATA/ Xl(l),LNEXT<l),ML3(l)»MUBaTiPRlMU)i 
1 TYPBLB<U,NaMeLB(1>i ILB(1J.FLB(1)|S1LB{1) 

1 TYpEUB(l) (NaMEUBIDi lUBtll iPUBlDiSiUBd) 

& VM8(l)tOWDV(l),x2CL(l),SLSWl(l)»MCLa)» 

& ANGTE(1),PTtE{1),?STE<1);FGrTE(1)|RGTB(1) 

& ANGEXPU) ,8sQEXP(479) 

CRVLE(l) ,aNGLE(D 

JSCHOKEiDWDV) » (CRVLE, AN5T6) i'UNGLE»PTTE) 

PRlM,TYPELB,TYPEU3,SCH0KEdT 


dimension 

equivalence 

integer 


common 

/CA2 

/ 

COMMON 

/CA3 

/ 

COMMON 

7Ca4 

/ 

COMMON 

/CA5 

/ 

COMMON 

/CA6 

/ 

COMMON 

/CA7 

/ 

COMMON 

/CA8 

/ 

DIMENSION 


equivalence 


COMMON 

/C8 

/ 

COMMON 

/CDPS2 

/ 

COMMON 

/CDS2 

/ 

COMMON 

/CIOEX 

/ 

COMMON 

/CIDEXR/ 

COMMON 

/CLBL 

7 

LOGICAL 


COMMON 

/CM 

/ 

common 

/ CMAX4 

COMMON 

/cmaxit/ 

common 

/CPI 

/ 

COMMON 

/CPRINT/ 

cOmmon 

/cPhS 

/ 

COMMON 

/CSS 

/ 


1 

integer 

logical 

COMMON /CTOLRL/ 

« 

COMMON /ERASE2/ 

tt 

COMMON /IXORIG/ 


A2<768) 

A3(768 ) 

A4(768) 

At>(768 ) 

A6(768) 

A7(768I 

A8(768l 

AO(300)rAl(300) 

{A0jA6),(A^iA5) 

8(768) 

DDS2 

DS2(768) 

MM2| J5>|MX,MDN, ISTag 

M,MJ1(4) ,m3,Mj2{4),M5,MJ4{4).M2,MJ5(4),M6,Mj6(4) 
LBL,lSS(2) »LBlOUM(5> 

LBL 

JMS<768) 

/ ES2MAXf ZMX, RmX, 0S2MAX* LDUMY 
MAXIT»NREFINiDUmIT(2) 

PIiDUMP1(5) 

RDUM(6UPRT(20) 

BhS(76B) 

SSFMLiSSEFiSSEAnG.SSDF.SSFEND.SSFNOA 

,SSDLE|A4FaCt,BRLX,CURRLX.TSIC 

SSFML 

SSEFi SSDF, SSDlE 

TOLRL|MAXSWP,CLEN,OS2MX*TOLES2»NSWP,DTOLRL{6)# 
*G1MIN,Tol1nR 

AA4(l28)»AA8{l28)|BB(128)»A4ia28)|A42U2B>, 

MSaVE(128) iDRaSe<732) 

lho;lhe» ubdo.lbde, lto;lte,' lwo.lwe, lfo.lfe, 

LO.LESTA, lDUM(8), 

mo,nm, nj.nfcols, maxnj;maxol,maxnm,maxle, 
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dimension 

EQUlVALENCfc 


UEO.Ufcfe, L«OiU«E,i.RD 

IIMITS(24) 

HIMITSjLhOI 




C INlTULliie PS2 TO 0,i NSapafl 
calc SETMUiO. iB82,NM) 


N S W P > 0 
ASSIGN 235 Tq I.GO 


AtlM » SORT! FLOAT(NM) ) 
LlMSWPs MAXSl3p.inX(AUlMU2 


FNM • 1,/ALIM 
CUENX * 4,«SG1M1N 
iTyPE • IADM42 
XXK « 0. 


RHO ■ RHOBaS 


C LOOP TO sweep through STATIONS 
LSTARTb lo 

lend ■ LESTa 

1F( .NOTVLBL ) go to 1 

IP( lss(2J;eq.o ;or, lss(2) .lt.lssii) > return 

C SET LIMITS FOR LINE BY LINE SUPERSONIC SOLUTION 

itype *2 

LSTaRT. lSS<D 
LEND « LS$(2)«1 
1 L « lstart 
DS2MX ■ 0, 

0DS2 f 0< 

IF( RHOAmP'.EQ.O; ) 60 TO lUl , 


C COMPUTE HMO -bITEHaTION EACTqR 

XXK • XXK*1, 

IF( XXK, 6E, ALIM J XXK*l, 

TSIN ■ SIN( ,5»X¥K*RIfFNM) 

RHO • RH08aS* 2,''«RH0AHP«TSIN»«2 
111! RHOl ■ 1,«RH0 

GO TO (200,2.2) , ITYPE 
c LOOP across streamlines 

2 MA i MLB(L) 

MB 0 MUB(L) 

IF(NSWP,GE',LIMSWR) PDUM(3)81, 

M ■ MA 

3 K >0 

4 K ■ K*1 


C BUILD coefficient TABLES FOR TdSeQ ON ORTHOGONaL 
C GET M2,M3,M5,M6 INDICES 

call getrlx 

C CALCULATE MODIFIED RIGHT HaNd SIDES 

IF( B(M) ,'LEiO, > GO TO 20 

C SUBSONIC BRANCH 

10 AA41 > .IA2(M)^A3(M)*A9(M)*A6(H)) 

AA42 ■ A4(M)-AA41 

BB(K> A RHS(M)p|A2(M)«0S2(M2)*A3<M)»DS2tMS)*RH0l»AA41«US2(M) 
• *A5(M)«P82(M5)*A6«4)»DS2(M8)T 

AA4K 0 AA42tRH0«AA41 
60 TO 30 


C SUPERSONIC BRANCH t,*-.i>.GET INDEX-» Ml 
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C SPtClAU 5 point CUBIC^» SSFMl»3i PICK UP AD 

20 MX ■ M2 

21 MM2 ■ Mi 
CALL GETIX 

1F( MX.EQ.O I MX»IM 
IFL ISTAS,BQ;3 ) UO TO ?1 
MXSAV * Ml 
25 MM2 s Ml 
call GETIX 
1F( Ml,EO.e ) MUM 
IF( ISTAe,EO,3 ) GO TO 25 
MO « Ml 
Ml • MISaV 

AA41 ■ -(A2(M>*A3(M)*A1(M)*A0(m>> 

AA42 I A4(M),.AA41 

BB(K) * RHS(M)-( Al(M)«P§2(Mi)*A2(M)*DS2(Ma)*A3(M)*DS2(M3)*RHOl» 
» AA41«US2(M) *A0(M)»DS2<M0M 

AA4K f AA42+RHQf AA41 
IF(SSFML,EQ,3) go to 2? 

c tridiagonal oecompositiqn 

C IF A 6 (M)rO, ADJUST LOCALLY Tq RHQsl 

30 IF( A6 (M) ,nE;o, ) GQ TO 3l 

29 BB(K) < BB(K)*RHQi«AA41»0S2(M) 

AA 4 K a A A 4 K «RMQittAA 4 l 

31 1F< K,Gb,2 ) GO TO 50 
AA8(K)« A8(M)/AA4K 
BB<K) « BB(K)/AA4K 

GO TO 61 

C forward DECOMPOSITION 

C special logic for 2 *ND of double POINTS 

50 IF(A4(M) ;NE,1, ) GO TO 51 
GO TO 60 

51 1F(A4(M*U ;NE.1, I GO TO 60 
IF( B(m).LE,0, J Go To 52 

AA41 a «(A2(M)tA3(N)*A5(M)*A6(M) ) 

GO TO 53 

52 AA41 » •( A2(M)*A3(H)*AI(M) ) 

53 AA42 s A4(M).AA41 
AA4K b AA42tRM04AA4l 

IF( A6(MJ.EQ,0, ,OR. <B<M),lE,0; ,aND, SSFML.EQ.S ) ) 

<»AA4K B AA4K«RM01ttAA41 
AA4K B l,/( AA4K4A7(M)*AA8(K«1)»AAB(K-2M 
AA6(K)8 A8(M}»AA4K 

BB(K) a {BB(K)»A7(M)*(BB(K-2)-AA8(K»2)«BBIK-1)))*AA4K 
GO TO 61 

60 AA4 K B 1,/(aA4K-A7IM)»AA8<K«i)> 

AAS(K)8 AB(M}»AA4K 

BB(K) B (BB(K)«A7(M)ttBB(K«l))»AA4K 

61 1 F( M,GE;mB ) GO TO 62 

M B M*1 

GO To 4 

62 DS2(M)a BBtK) 

C BACK substitution 
70 M B M*1 

K « K-1 

IF( M,LT,MA ) GO TO IQP 
BB(K) b 6B(K}«AA8(K)aBB(K«l) 
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c CAUCULATfc DDS2,0S2MX 

IF ( ABS<BB(K) • OSa(M> ) ,LT. DDS 2 ) GO TO 75 
HDDS2 ■ H 

D0S2 ■ ABS(BB(K) • Di>2(H) ) 

75 DS2(M)« BB<K) 

DS2HX ■ AMAXK P$2HXiABS(0S2(M)) ) 

GO TO TO 

C INDEX TO NEXT STATION 

100 IF( DS 2 MX,GT,CI.ENX ) OALL ERRORl 
L • L*UNEXTa) 

JF( l.lt.lend > go to 2 

c INCREMENT SWEEP COUNTER 
NSWP • NSWPtl 

IF( PDUHI3) ,NE,0V ) CAU TAflPRT (5NDS2 bA»D62 » NM , NJ J 
IF( PDUM(3> ,NE,0V ) write (6i 999» DDS2.MDbS2*DS8MX,RH0 
999 r0RMAT<//6Xi5HDDS2silPE16,8,6x.7HMDDS28 i T 4 i 6X i 6 HDS 2 MXs*El 6 , 8 , 
I 6Xi4HRHO*|ORF12V8//) 

IF( IA0H;eQ,1 ,0R, IBl » GO To 321 

c LOOP To swggp CROSS, stream alOng streamlincS 

C N0TE»*« ISTAG»3 POINTS A«E SkIPPED 

200 J2 iNj 

DS2MX ■ 0, 

202 M 8 HBEGIN(J2) 

c construct matrix coefficients along streamline 

K f 0 

203 K ■ K*t 

C GET INDICES M2,M3|M5,M6 

205 MSAVE(K)4 M 
CALL GETRLX 

C IF B(M) ,LE. 0 , ••(SUPERSONIC-* SUBTRACT A 1 »DS 2 (MD FROM BB 
C IF SSFML,E0,3 also subtract aO#DS 2 CMO) FROM BB 
A4lK f -IA2(M)*A3(M}*A9(M)«A6(M)) 

1 F( B<M),UE, 0 , » A41KsA41K*a5(M)*A6<M) 

A42K I A4(M)*A41K 
AA 4 K s A4 JK^rH0#A42K 
HOB ■ M-1 

IF( A4<M-1) ,EO,lV) MD8fM-2 

8 B(K) 9 RHS<M)-I A7(M)«P52(MDB)*RH0i»a42R*&S2CM) 

9 *A8(M)*PS2(M*1) ) 

IF( B(M),GT, 0 , ) 00 TO 206 
Ml B M2 

2051 hm 2 ■ Ml 

CALL GETIx 

IF( Ml.EQ-.O ) M14M 

IF( ISTA6',EO;3 ) GO TO 2051 

MISAV * Ml 

2052 MM2 ■ Ml 
call GETIX 

IF( Ml.EO'.O ) M14M 
IF( ISTAG;EQ;3 ) GO TO 2052 
MO B Ml 

Ml 8 MlSAV 

BB(K) 8 BB(K).aUM}«dS2(M1).A0(M)«DS2(M01I 


C PENTA. diagonal matrix— decomposition 

C ADJUST TO RHObI IF A7(MJ?0. 

206 1F( A7<M|,NE;o, } GO TQ 2q7 

BB(K) 8 BB(K}*RHQ1«A42K8DS2(M) 
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AA4K a AA4K«RH01«A42K 

207 1F( K,GT,2 ) GO TO 220 
GO TO <208|2i0) i K 

208 CM m x;/AA4K 

A41(K)» a5(M)*CM 

ir ( B(M) ,LB,0, ) A4i(K)»0, 

A42(K)« A6(M)»CM 

JF( B(M).LB,0. ,AN0,. SSrML,60.3 ) A42(K»«t), 

BB<K> » 

GO TO 225 

210 CM ■ 1 ,/< AA4k»A3<M*»A4i<k-iM 

A41(K)s (A5(M)-a3(M)»A42(k- 1) )«CM 
!F( B(M),LB,o, ) A4l<t< J*A41 (K)«a 5(M)«CM 
A42(K)n A6fM)»CM 

JF( B(M).LEiO. .and. SSFML,EQ.3 ) A42(K) t A42 ( K) »A6 (H ) *CH 
BB(K) « (eB(K)«A3tH)«BB(K.l) )»CM 
GO To 225 

220 CMA ■ A3(M)-A2^M)«a41(K-2) 

CM > l,/( AA4K.A2(M)»A42tK»2)pCMA»A4i(K.m 

A4KK)* ( A3(M)-CMAoA42(K«i) )»CM 
IF( B(M),LE,0, ) A41(K)*A41(K)«a5(M)*CM 
A42(K)* A6(N)»CM 

1F( B<M),LE,0. ,AND. SSFMu,E 3.3 ) A42<K> » A42( K ) • A8<M ) «CM 
BB(K) 8 {BB(K)-A2(M)*BB(K»2)«CMA»3B(K8l))ftCM 
225 IF( M5,fcQ,M ) GO TO 230 
M 8 M5 

GO TO 203 

C BACK"SUBST1TUT10N uoqp 

230 ASSIGN 231 TQ JGQ 
GO To 250 

231 K « K*1 

ASSIGN 240 To JGO 

BB(K) 8 BB(K).A41(K}*Bb(K«l ) 

M 8 MSAVE(K) 

GO TO 250 
240 K 8 K-l 

M » MSA'^E<K) 

IF( Kil,T.i ) GO TO 300 

B8<K) 8 BB<K|,A41(KI*6B<K*l)«A42(i<)»BB{K*2) 

C CALCULATE DUS2,0S2MX 

250 IF ( A0S(8B(K) - US2(M) ) ,lT. DDS2 ) GO TO 255 
M0DS2 8 M 

D0S2 ■ ABS(BB(K} > dS2<M) ) 

255 DS2(M)8 BBIK) 

0S2MX 8 AMAXl(OS2MxyA0S(DS2(M)) ) 

' GO TO JGO , (231,240) 

300 IF( DS2MX.GT,ClEMX ) CALL ErRORI 
J2 « J28l 

IF(J2,gt;o) go to 202 

IF( PDUM(3) ,NE,0,‘ ) CALL TA8PRT(5HDS2®B,DS27NM,NJ) 

1F( PDUM13) ,NE.0V > WRITE (6,999> DDS2, MD0S2, DS2MX, RHO 

c increment sweep counter 

320 NSWP 8 N|SWP«1 

C streamline sweep complete-- check CONVER5EWCE 

321 IF( DDs2;lEiT0LRL»DS2MX J Go to 9oo 
IF{ nshp;le,maxswp ) go to 1 
ASSIGN 234 Tq LGO 

902 GO TO LGO , (234,235) 
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234 CALL ERRORt 

235 IF(PDUM(3);eo,0;| go to 260 
write *6aooo) 

DO 400 IaIiNm 

^KRITE (6;i,0t, l»BU>.«(||,*3M),A4n)i»S(|,.A«(|,,A7(|). 
400 continue 



' 260 CALL*SlNikv"“'nSS* ' SIGN ) 

*° ir^( 4BS(DS?itN?*V}' I'Jj “S2HIN, IM|N, D|2 NAn, IMA* ) 
RETURN* I BS?«At A DS2MIN 

END 


ASU), 

* lOXi 
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